summaryrefslogtreecommitdiffstats
ModeNameSize
-rw-r--r--COPYING4048logstatsplain
-rw-r--r--MANIFEST34698logstatsplain
-rw-r--r--Makefile.dist615logstatsplain
-rw-r--r--Makefile.in5091logstatsplain
-rw-r--r--README.txt1702logstatsplain
-rw-r--r--acconfig.h1539logstatsplain
-rw-r--r--aclocal.m415111logstatsplain
d---------bin828logstatsplain
d---------c++283logstatsplain
d---------config1232logstatsplain
-rwxr-xr-xconfigure279085logstatsplain
-rw-r--r--configure.in55424logstatsplain
d---------doc131logstatsplain
d---------examples647logstatsplain
d---------fortran433logstatsplain
d---------hl32logstatsplain
d---------pablo557logstatsplain
d---------perform454logstatsplain
d---------release_docs336logstatsplain
d---------src5055logstatsplain
d---------test2248logstatsplain
d---------testpar301logstatsplain
d---------tools340logstatsplain
d---------windows162logstatsplain
poll'>dkf_notifier_poll Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog1081
-rw-r--r--README237
-rw-r--r--changes587
-rw-r--r--compat/memcmp.c61
-rw-r--r--compat/stdlib.h4
-rw-r--r--compat/strftime.c8
-rw-r--r--compat/string.h6
-rw-r--r--doc/AssocData.34
-rw-r--r--doc/Async.34
-rw-r--r--doc/Backslash.330
-rw-r--r--doc/CrtChannel.363
-rw-r--r--doc/CrtObjCmd.321
-rw-r--r--doc/Encoding.3484
-rw-r--r--doc/Eval.3187
-rw-r--r--doc/EvalObj.391
-rw-r--r--doc/Exit.346
-rwxr-xr-xdoc/GetCwd.354
-rw-r--r--doc/GetIndex.331
-rwxr-xr-x[-rw-r--r--]doc/GetVersion.3 (renamed from doc/CrtVersion.3)8
-rw-r--r--doc/ObjSetVar.3162
-rw-r--r--doc/Object.313
-rw-r--r--doc/OpenFileChnl.3325
-rw-r--r--doc/ParseCmd.3426
-rw-r--r--doc/RegExp.321
-rw-r--r--doc/SaveResult.365
-rw-r--r--doc/SetRecLmt.34
-rw-r--r--doc/SetVar.3211
-rw-r--r--doc/StringObj.332
-rw-r--r--doc/Tcl.n68
-rw-r--r--doc/Thread.3100
-rw-r--r--doc/ToUpper.390
-rw-r--r--doc/TraceVar.342
-rw-r--r--doc/Translate.38
-rw-r--r--doc/Utf.3160
-rw-r--r--doc/binary.n22
-rw-r--r--doc/catch.n62
-rw-r--r--doc/dde.n124
-rw-r--r--doc/encoding.n79
-rw-r--r--doc/exec.n17
-rw-r--r--doc/fconfigure.n194
-rw-r--r--doc/format.n6
-rw-r--r--doc/glob.n19
-rw-r--r--doc/http.n6
-rw-r--r--doc/library.n24
-rw-r--r--doc/man.macros4
-rw-r--r--doc/msgcat.n207
-rw-r--r--doc/namespace.n54
-rw-r--r--doc/open.n6
-rw-r--r--doc/puts.n6
-rw-r--r--doc/read.n6
-rw-r--r--doc/regexp.n1083
-rw-r--r--doc/registry.n3
-rw-r--r--doc/resource.n4
-rw-r--r--doc/safe.n19
-rw-r--r--doc/scan.n68
-rw-r--r--doc/socket.n6
-rw-r--r--doc/string.n40
-rw-r--r--doc/tclvars.n17
-rw-r--r--generic/regc_color.c742
-rw-r--r--generic/regc_cvec.c170
-rw-r--r--generic/regc_lex.c1010
-rw-r--r--generic/regc_locale.c781
-rw-r--r--generic/regc_nfa.c1528
-rw-r--r--generic/regcomp.c2124
-rw-r--r--generic/regcustom.h85
-rw-r--r--generic/rege_dfa.c627
-rw-r--r--generic/regerror.c82
-rw-r--r--generic/regerrs.h18
-rw-r--r--generic/regex.h308
-rw-r--r--generic/regexec.c952
-rw-r--r--generic/regexp.c1333
-rw-r--r--generic/regfree.c25
-rw-r--r--generic/regfronts.c56
-rw-r--r--generic/regguts.h388
-rw-r--r--generic/tcl.decls364
-rw-r--r--generic/tcl.h540
-rw-r--r--generic/tclAlloc.c245
-rw-r--r--generic/tclAsync.c17
-rw-r--r--generic/tclBasic.c1378
-rw-r--r--generic/tclBinary.c425
-rw-r--r--generic/tclCkalloc.c193
-rw-r--r--generic/tclClock.c48
-rw-r--r--generic/tclCmdAH.c1442
-rw-r--r--generic/tclCmdIL.c366
-rw-r--r--generic/tclCmdMZ.c1715
-rw-r--r--generic/tclCompCmds.c1980
-rw-r--r--generic/tclCompExpr.c2598
-rw-r--r--generic/tclCompile.c8197
-rw-r--r--generic/tclCompile.h554
-rw-r--r--generic/tclDate.c24
-rw-r--r--generic/tclDecls.h1880
-rw-r--r--generic/tclEncoding.c2685
-rw-r--r--generic/tclEnv.c437
-rw-r--r--generic/tclEvent.c655
-rw-r--r--generic/tclExecute.c2047
-rw-r--r--generic/tclFCmd.c123
-rw-r--r--generic/tclFileName.c604
-rw-r--r--generic/tclGet.c60
-rw-r--r--generic/tclGetDate.y24
-rw-r--r--generic/tclHash.c7
-rw-r--r--generic/tclHistory.c26
-rw-r--r--generic/tclIO.c4526
-rw-r--r--generic/tclIOCmd.c733
-rw-r--r--generic/tclIOSock.c29
-rw-r--r--generic/tclIOUtil.c148
-rw-r--r--generic/tclIndexObj.c160
-rw-r--r--generic/tclInitScript.h88
-rw-r--r--generic/tclInt.decls238
-rw-r--r--generic/tclInt.h885
-rw-r--r--generic/tclIntDecls.h773
-rw-r--r--generic/tclIntPlatDecls.h337
-rw-r--r--generic/tclIntPlatStubs.c553
-rw-r--r--generic/tclIntStubs.c1333
-rw-r--r--generic/tclInterp.c4508
-rw-r--r--generic/tclLink.c41
-rw-r--r--generic/tclListObj.c15
-rw-r--r--generic/tclLiteral.c929
-rw-r--r--generic/tclLoad.c253
-rw-r--r--generic/tclLoadNone.c6
-rw-r--r--generic/tclMain.c142
-rw-r--r--generic/tclNamesp.c184
-rw-r--r--generic/tclNotify.c508
-rw-r--r--generic/tclObj.c365
-rw-r--r--generic/tclParse.c2544
-rw-r--r--generic/tclParseExpr.c1826
-rw-r--r--generic/tclPipe.c94
-rw-r--r--generic/tclPkg.c476
-rw-r--r--generic/tclPlatDecls.h75
-rw-r--r--generic/tclPlatStubs.c116
-rw-r--r--generic/tclPort.h4
-rw-r--r--generic/tclPosixStr.c6
-rw-r--r--generic/tclPreserve.c217
-rw-r--r--generic/tclProc.c185
-rw-r--r--generic/tclRegexp.c792
-rw-r--r--generic/tclRegexp.h104
-rw-r--r--generic/tclResult.c1025
-rw-r--r--generic/tclScan.c1032
-rw-r--r--generic/tclStringObj.c51
-rw-r--r--generic/tclStubInit.c164
-rw-r--r--generic/tclStubs.c685
-rw-r--r--generic/tclTest.c1315
-rw-r--r--generic/tclTestObj.c193
-rw-r--r--generic/tclThread.c563
-rw-r--r--generic/tclThreadTest.c898
-rw-r--r--generic/tclTimer.c388
-rw-r--r--generic/tclUniData.c621
-rw-r--r--generic/tclUtf.c1287
-rw-r--r--generic/tclUtil.c1395
-rw-r--r--generic/tclVar.c715
-rw-r--r--library/auto.tcl553
-rw-r--r--library/encoding/ascii.enc20
-rw-r--r--library/encoding/big5.enc1516
-rw-r--r--library/encoding/cp1250.enc20
-rw-r--r--library/encoding/cp1251.enc20
-rw-r--r--library/encoding/cp1252.enc20
-rw-r--r--library/encoding/cp1253.enc20
-rw-r--r--library/encoding/cp1254.enc20
-rw-r--r--library/encoding/cp1255.enc20
-rw-r--r--library/encoding/cp1256.enc20
-rw-r--r--library/encoding/cp1257.enc20
-rw-r--r--library/encoding/cp1258.enc20
-rw-r--r--library/encoding/cp437.enc20
-rw-r--r--library/encoding/cp737.enc20
-rw-r--r--library/encoding/cp775.enc20
-rw-r--r--library/encoding/cp850.enc20
-rw-r--r--library/encoding/cp852.enc20
-rw-r--r--library/encoding/cp855.enc20
-rw-r--r--library/encoding/cp857.enc20
-rw-r--r--library/encoding/cp860.enc20
-rw-r--r--library/encoding/cp861.enc20
-rw-r--r--library/encoding/cp862.enc20
-rw-r--r--library/encoding/cp863.enc20
-rw-r--r--library/encoding/cp864.enc20
-rw-r--r--library/encoding/cp865.enc20
-rw-r--r--library/encoding/cp866.enc20
-rw-r--r--library/encoding/cp869.enc20
-rw-r--r--library/encoding/cp874.enc20
-rw-r--r--library/encoding/cp932.enc785
-rw-r--r--library/encoding/cp936.enc2162
-rw-r--r--library/encoding/cp949.enc2128
-rw-r--r--library/encoding/cp950.enc1499
-rw-r--r--library/encoding/dingbats.enc20
-rw-r--r--library/encoding/euc-cn.enc1397
-rw-r--r--library/encoding/euc-jp.enc1346
-rw-r--r--library/encoding/euc-kr.enc1533
-rw-r--r--library/encoding/gb12345.enc1414
-rw-r--r--library/encoding/gb1988.enc20
-rw-r--r--library/encoding/gb2312.enc1380
-rw-r--r--library/encoding/iso2022-jp.enc12
-rw-r--r--library/encoding/iso2022-kr.enc7
-rw-r--r--library/encoding/iso2022.enc16
-rw-r--r--library/encoding/iso8859-1.enc20
-rw-r--r--library/encoding/iso8859-2.enc20
-rw-r--r--library/encoding/iso8859-3.enc20
-rw-r--r--library/encoding/iso8859-4.enc20
-rw-r--r--library/encoding/iso8859-5.enc20
-rw-r--r--library/encoding/iso8859-6.enc20
-rw-r--r--library/encoding/iso8859-7.enc20
-rw-r--r--library/encoding/iso8859-8.enc20
-rw-r--r--library/encoding/iso8859-9.enc20
-rw-r--r--library/encoding/jis0201.enc20
-rw-r--r--library/encoding/jis0208.enc1312
-rw-r--r--library/encoding/jis0212.enc1159
-rw-r--r--library/encoding/ksc5601.enc1516
-rw-r--r--library/encoding/macCentEuro.enc20
-rw-r--r--library/encoding/macCroatian.enc20
-rw-r--r--library/encoding/macCyrillic.enc20
-rw-r--r--library/encoding/macDingbats.enc20
-rw-r--r--library/encoding/macGreek.enc20
-rw-r--r--library/encoding/macIceland.enc20
-rw-r--r--library/encoding/macJapan.enc785
-rw-r--r--library/encoding/macRoman.enc20
-rw-r--r--library/encoding/macRomania.enc20
-rw-r--r--library/encoding/macThai.enc20
-rw-r--r--library/encoding/macTurkish.enc20
-rw-r--r--library/encoding/macUkraine.enc20
-rw-r--r--library/encoding/shiftjis.enc683
-rw-r--r--library/encoding/symbol.enc20
-rw-r--r--library/init.tcl1015
-rw-r--r--library/msgcat/msgcat.tcl177
-rw-r--r--library/msgcat/pkgIndex.tcl1
-rw-r--r--library/msgcat1.0/msgcat.tcl177
-rw-r--r--library/msgcat1.0/pkgIndex.tcl1
-rw-r--r--library/opt/optparse.tcl (renamed from library/opt0.1/optparse.tcl)36
-rw-r--r--library/opt/pkgIndex.tcl11
-rw-r--r--library/opt0.1/pkgIndex.tcl7
-rw-r--r--library/opt0.4/optparse.tcl1097
-rw-r--r--library/opt0.4/pkgIndex.tcl11
-rw-r--r--library/package.tcl473
-rw-r--r--library/safe.tcl48
-rw-r--r--library/tclIndex58
-rw-r--r--library/word.tcl7
-rw-r--r--mac/MW_TclHeader.pch6
-rw-r--r--mac/README65
-rw-r--r--mac/tclMacAppInit.c4
-rw-r--r--mac/tclMacBOAAppInit.c4
-rw-r--r--mac/tclMacBOAMain.c27
-rw-r--r--mac/tclMacChan.c159
-rw-r--r--mac/tclMacExit.c4
-rw-r--r--mac/tclMacFCmd.c465
-rw-r--r--mac/tclMacFile.c660
-rw-r--r--mac/tclMacInit.c592
-rw-r--r--mac/tclMacInt.h13
-rw-r--r--mac/tclMacLibrary.r6
-rw-r--r--mac/tclMacLoad.c61
-rw-r--r--mac/tclMacNotify.c146
-rw-r--r--mac/tclMacOSA.c8
-rw-r--r--mac/tclMacPort.h236
-rw-r--r--mac/tclMacResource.c88
-rw-r--r--mac/tclMacResource.r6
-rw-r--r--mac/tclMacShLib.exp5
-rw-r--r--mac/tclMacSock.c216
-rw-r--r--mac/tclMacTclCode.r36
-rw-r--r--mac/tclMacThrd.c795
-rw-r--r--mac/tclMacThrd.h20
-rw-r--r--mac/tclMacUnix.c145
-rw-r--r--tests/README489
-rw-r--r--tests/all71
-rw-r--r--tests/all.tcl76
-rw-r--r--tests/append.test28
-rw-r--r--tests/assocd.test24
-rw-r--r--tests/async.test25
-rw-r--r--tests/autoMkindex.test64
-rw-r--r--tests/basic.test230
-rw-r--r--tests/binary.test25
-rw-r--r--tests/case.test23
-rw-r--r--tests/clock.test74
-rw-r--r--tests/cmdAH.test779
-rw-r--r--tests/cmdIL.test40
-rw-r--r--tests/cmdInfo.test26
-rw-r--r--tests/cmdMZ.test581
-rw-r--r--tests/compExpr-old.test687
-rw-r--r--tests/compExpr.test340
-rw-r--r--tests/compile.test58
-rw-r--r--tests/concat.test23
-rw-r--r--tests/dcall.test26
-rw-r--r--tests/defs460
-rw-r--r--tests/defs.tcl990
-rw-r--r--tests/dstring.test25
-rw-r--r--tests/encoding.test316
-rw-r--r--tests/env.test161
-rw-r--r--tests/error.test23
-rw-r--r--tests/eval.test23
-rw-r--r--tests/event.test606
-rw-r--r--tests/exec.test228
-rw-r--r--tests/execute.test450
-rw-r--r--tests/expr-old.test41
-rw-r--r--tests/expr.test75
-rw-r--r--tests/fCmd.test548
-rw-r--r--tests/fileName.test292
-rw-r--r--tests/for-old.test22
-rw-r--r--tests/for.test178
-rw-r--r--tests/foreach.test34
-rw-r--r--tests/format.test261
-rw-r--r--tests/get.test41
-rw-r--r--tests/history.test25
-rw-r--r--tests/http.test202
-rw-r--r--tests/httpd148
-rw-r--r--tests/httpold.test52
-rw-r--r--tests/if-old.test23
-rw-r--r--tests/if.test602
-rw-r--r--tests/incr-old.test23
-rw-r--r--tests/incr.test273
-rw-r--r--tests/indexObj.test24
-rw-r--r--tests/info.test233
-rw-r--r--tests/init.test36
-rw-r--r--tests/interp.test179
-rw-r--r--tests/io.test2645
-rw-r--r--tests/ioCmd.test62
-rw-r--r--tests/ioUtil.test68
-rw-r--r--tests/join.test21
-rw-r--r--tests/lindex.test23
-rw-r--r--tests/link.test27
-rw-r--r--tests/linsert.test22
-rw-r--r--tests/list.test23
-rw-r--r--tests/listObj.test33
-rw-r--r--tests/llength.test23
-rw-r--r--tests/load.test110
-rw-r--r--tests/lrange.test23
-rw-r--r--tests/lreplace.test22
-rw-r--r--tests/lsearch.test25
-rw-r--r--tests/macFCmd.test158
-rw-r--r--tests/misc.test30
-rw-r--r--tests/msgcat.test318
-rw-r--r--tests/namespace-old.test23
-rw-r--r--tests/namespace.test22
-rw-r--r--tests/obj.test176
-rw-r--r--tests/opt.test29
-rw-r--r--tests/osa.test41
-rw-r--r--tests/parse.test1257
-rw-r--r--tests/parseExpr.test637
-rw-r--r--tests/parseOld.test546
-rw-r--r--tests/pid.test28
-rw-r--r--tests/pkg.test31
-rw-r--r--tests/pkg/import.tcl16
-rw-r--r--tests/pkgMkIndex.test76
-rw-r--r--tests/platform.test25
-rw-r--r--tests/proc-old.test22
-rw-r--r--tests/proc.test23
-rw-r--r--tests/pwd.test23
-rw-r--r--tests/reg.test905
-rw-r--r--tests/regexp.test82
-rw-r--r--tests/registry.test320
-rw-r--r--tests/remote.tcl13
-rw-r--r--tests/rename.test22
-rw-r--r--tests/resource.test142
-rw-r--r--tests/result.test102
-rw-r--r--tests/safe.test107
-rw-r--r--tests/scan.test482
-rw-r--r--tests/security.test53
-rw-r--r--tests/set-old.test25
-rw-r--r--tests/set.test274
-rw-r--r--tests/socket.test338
-rw-r--r--tests/source.test56
-rw-r--r--tests/split.test23
-rw-r--r--tests/stack.test24
-rw-r--r--tests/string.test29
-rw-r--r--tests/stringObj.test26
-rw-r--r--tests/subst.test25
-rw-r--r--tests/switch.test27
-rw-r--r--tests/thread.test240
-rw-r--r--tests/timer.test103
-rw-r--r--tests/trace.test28
-rw-r--r--tests/unixFCmd.test168
-rw-r--r--tests/unixFile.test53
-rw-r--r--tests/unixInit.test205
-rw-r--r--tests/unixNotfy.test73
-rw-r--r--tests/unknown.test23
-rw-r--r--tests/uplevel.test23
-rw-r--r--tests/upvar.test23
-rw-r--r--tests/utf.test276
-rw-r--r--tests/util.test230
-rw-r--r--tests/var.test28
-rw-r--r--tests/while-old.test23
-rw-r--r--tests/while.test324
-rw-r--r--tests/winConsole.test51
-rw-r--r--tests/winDde.test152
-rw-r--r--tests/winFCmd.test419
-rw-r--r--tests/winFile.test64
-rw-r--r--tests/winNotify.test56
-rw-r--r--tests/winPipe.test298
-rw-r--r--tests/winTime.test49
-rwxr-xr-xtools/checkLibraryDoc.tcl242
-rw-r--r--tools/configure.in7
-rw-r--r--tools/cvtEOL.tcl35
-rw-r--r--tools/encoding/Makefile110
-rw-r--r--tools/encoding/README5
-rw-r--r--tools/encoding/ascii.txt95
-rw-r--r--tools/encoding/big5.txt13906
-rw-r--r--tools/encoding/cjk.inf4467
-rw-r--r--tools/encoding/cp1250.txt275
-rw-r--r--tools/encoding/cp1251.txt275
-rw-r--r--tools/encoding/cp1252.txt275
-rw-r--r--tools/encoding/cp1253.txt275
-rw-r--r--tools/encoding/cp1254.txt275
-rw-r--r--tools/encoding/cp1255.txt275
-rw-r--r--tools/encoding/cp1256.txt275
-rw-r--r--tools/encoding/cp1257.txt275
-rw-r--r--tools/encoding/cp1258.txt275
-rw-r--r--tools/encoding/cp437.txt274
-rw-r--r--tools/encoding/cp737.txt274
-rw-r--r--tools/encoding/cp775.txt275
-rw-r--r--tools/encoding/cp850.txt274
-rw-r--r--tools/encoding/cp852.txt274
-rw-r--r--tools/encoding/cp855.txt275
-rw-r--r--tools/encoding/cp857.txt275
-rw-r--r--tools/encoding/cp860.txt275
-rw-r--r--tools/encoding/cp861.txt275
-rw-r--r--tools/encoding/cp862.txt275
-rw-r--r--tools/encoding/cp863.txt275
-rw-r--r--tools/encoding/cp864.txt275
-rw-r--r--tools/encoding/cp865.txt275
-rw-r--r--tools/encoding/cp866.txt275
-rw-r--r--tools/encoding/cp869.txt275
-rw-r--r--tools/encoding/cp874.txt275
-rw-r--r--tools/encoding/cp932.txt7999
-rw-r--r--tools/encoding/cp936.txt22066
-rw-r--r--tools/encoding/cp949.txt17321
-rw-r--r--tools/encoding/cp950.txt13775
-rw-r--r--tools/encoding/dingbats.txt250
-rw-r--r--tools/encoding/gb12345.txt7604
-rw-r--r--tools/encoding/gb1988.txt158
-rw-r--r--tools/encoding/gb2312.txt7515
-rw-r--r--tools/encoding/iso2022-jp.esc10
-rw-r--r--tools/encoding/iso2022-kr.esc5
-rw-r--r--tools/encoding/iso2022.esc14
-rw-r--r--tools/encoding/iso8859-1.txt230
-rw-r--r--tools/encoding/iso8859-2.txt230
-rw-r--r--tools/encoding/iso8859-3.txt223
-rw-r--r--tools/encoding/iso8859-4.txt230
-rw-r--r--tools/encoding/iso8859-5.txt230
-rw-r--r--tools/encoding/iso8859-6.txt185
-rw-r--r--tools/encoding/iso8859-7.txt224
-rw-r--r--tools/encoding/iso8859-8.txt192
-rw-r--r--tools/encoding/iso8859-9.txt232
-rw-r--r--tools/encoding/jis0201.txt202
-rw-r--r--tools/encoding/jis0208.txt6940
-rw-r--r--tools/encoding/jis0212.txt6141
-rw-r--r--tools/encoding/ksc5601.txt8262
-rw-r--r--tools/encoding/macCentEuro.txt293
-rw-r--r--tools/encoding/macCroatian.txt287
-rw-r--r--tools/encoding/macCyrillic.txt287
-rw-r--r--tools/encoding/macDingbats.txt260
-rw-r--r--tools/encoding/macGreek.txt290
-rw-r--r--tools/encoding/macIceland.txt285
-rw-r--r--tools/encoding/macJapan.txt7598
-rw-r--r--tools/encoding/macRoman.txt301
-rw-r--r--tools/encoding/macRomania.txt285
-rw-r--r--tools/encoding/macThai.txt299
-rw-r--r--tools/encoding/macTurkish.txt289
-rw-r--r--tools/encoding/macUkraine.txt279
-rw-r--r--tools/encoding/shiftjis.txt7096
-rw-r--r--tools/encoding/symbol.txt265
-rw-r--r--tools/encoding/txt2enc.c244
-rw-r--r--tools/genStubs.tcl10
-rw-r--r--tools/genWinImage.tcl120
-rw-r--r--tools/man2html.tcl181
-rw-r--r--tools/man2html1.tcl269
-rw-r--r--tools/man2html2.tcl871
-rw-r--r--tools/man2tcl.c4
-rw-r--r--tools/regexpTestLib.tcl266
-rw-r--r--tools/str2c61
-rw-r--r--tools/tcl.hpj.in6
-rw-r--r--tools/tcl.wse.in2330
-rw-r--r--tools/tcl8.1-tk8.1-man-html.tcl1662
-rw-r--r--tools/tclSplash.bmpbin0 -> 162030 bytes
-rw-r--r--tools/tclmin.wse247
-rw-r--r--tools/uniParse.tcl369
-rw-r--r--tools/white.bmpbin0 -> 20522 bytes
-rw-r--r--unix/Makefile.in207
-rw-r--r--unix/README22
-rw-r--r--unix/configure.in140
-rw-r--r--unix/dltest/Makefile.in5
-rw-r--r--unix/dltest/configure.in4
-rw-r--r--unix/dltest/pkge.c6
-rw-r--r--unix/dltest/pkgf.c5
-rw-r--r--unix/mkLinks276
-rw-r--r--unix/porting.notes417
-rw-r--r--unix/tclAppInit.c29
-rw-r--r--unix/tclLoadAix.c6
-rw-r--r--unix/tclLoadAout.c69
-rw-r--r--unix/tclLoadDl.c82
-rw-r--r--unix/tclLoadDld.c47
-rw-r--r--unix/tclLoadNext.c41
-rw-r--r--unix/tclLoadOSF.c42
-rw-r--r--unix/tclLoadShl.c57
-rw-r--r--unix/tclMtherr.c13
-rw-r--r--unix/tclUnixChan.c558
-rw-r--r--unix/tclUnixEvent.c4
-rw-r--r--unix/tclUnixFCmd.c711
-rw-r--r--unix/tclUnixFile.c603
-rw-r--r--unix/tclUnixInit.c508
-rw-r--r--unix/tclUnixNotfy.c643
-rw-r--r--unix/tclUnixPipe.c103
-rw-r--r--unix/tclUnixPort.h136
-rw-r--r--unix/tclUnixSock.c38
-rw-r--r--unix/tclUnixTest.c114
-rw-r--r--unix/tclUnixThrd.c682
-rw-r--r--unix/tclUnixThrd.h21
-rw-r--r--unix/tclUnixTime.c17
-rw-r--r--unix/tclXtTest.c4
-rw-r--r--win/README57
-rw-r--r--win/README.binary905
-rw-r--r--win/makefile.bc388
-rw-r--r--win/makefile.vc238
-rw-r--r--win/pkgIndex.tcl5
-rw-r--r--win/tcl.rc14
-rw-r--r--win/tclAppInit.c47
-rw-r--r--win/tclWin32Dll.c543
-rw-r--r--win/tclWinChan.c610
-rw-r--r--win/tclWinConsole.c1272
-rw-r--r--win/tclWinDde.c1287
-rw-r--r--win/tclWinError.c5
-rw-r--r--win/tclWinFCmd.c1036
-rw-r--r--win/tclWinFile.c991
-rw-r--r--win/tclWinInit.c652
-rw-r--r--win/tclWinInt.h68
-rw-r--r--win/tclWinLoad.c77
-rw-r--r--win/tclWinMtherr.c15
-rw-r--r--win/tclWinNotify.c355
-rw-r--r--win/tclWinPipe.c1588
-rw-r--r--win/tclWinPort.h371
-rw-r--r--win/tclWinReg.c420
-rw-r--r--win/tclWinSerial.c1401
-rw-r--r--win/tclWinSock.c671
-rw-r--r--win/tclWinTest.c5
-rw-r--r--win/tclWinThrd.c900
-rw-r--r--win/tclWinThrd.h21
-rw-r--r--win/tclWinTime.c122
-rw-r--r--win/tclsh.rc10
530 files changed, 261415 insertions, 40161 deletions
diff --git a/ChangeLog b/ChangeLog
index 1d3eaf2..b9d5dc4 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,222 +1,560 @@
1999-04-15 <stanton@scriptics.com>
- * Merge 8.0.5 changes:
- - Mac changes for final release
- - Minor fixes to tools configure file
-
+ * 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-03-12 <stanton@GASPODE>
+1999-04-09 <redman@scriptics.com>
- * generic/tcl.h: Changed magic number so it doesn't match the plus
- patch, at Jan's request.
+ * 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-03-11 <stanton@GASPODE>
+1999-04-06 <stanton@scriptics.com>
- * 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.
+ * tests/unixNotfy.test: Fixed hang in tests when built with thread
+ support.
-1999-03-10 <stanton@GASPODE>
+ * tests/httpold.test: Fixed broken test that didn't wait long
+ enough for events to arrive.
- * generic/tclAlloc.c: Changed TCL_NATIVE_MALLOC to USE_TCLALLOC so
- it matches 8.1.
+ * tests/unixInit.test: Fixed race condition in test.
- * generic/tclBasic.c:
- * 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.
+ * 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.
- * unix/Makefile.in: Added compat binaries to the stub library.
- Changed compat binaries to always compile with shared flags since
- they need to be shared for the stub library.
+ * generic/tclEncoding.c (Tcl_CreateEncoding): Minor lint to make
+ it easier to compile on Digital-unix. [Bug: 1659]
-1999-03-10 <redman@scriptics.com>
+ * 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/tclBasic.c: Add Tcl_GetVersion() to public C API to
- allow checking of the Tcl library's version number at runtime.
+ * 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).
-1999-03-09 <stanton@GASPODE>
+ * 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.
- * generic/tcl.h: Changed TCL_STUB_MAGIC back to match plus patch
- implementation.
+1999-04-05 <stanton@scriptics.com>
- * Regenerated stub interfaces.
+ * 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.
- * tools/genStubs.tcl: Reorganized code to support mixed generic
- and platform specific tables.
+ * 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
- * generic/tclInt.decls: Removed TclCompile*Cmd routines from the
- table.
+1999-04-01 <stanton@scriptics.com>
- * generic/tcl.decls: Moved old Unix fd handler routines into
- generic table and modified stubs ordering to match the plus patch.
+ * tests/registry.test:
+ * win/tclWinReg.c: Internationalized the registry code. It now
+ uses Unicode interfaces on NT. [Bug: 1197]
- * win/tclWinChan.c (FileSeekProc): Fixed bug where errors during
- seeking were not getting propagated.
+ * 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]
-1999-03-08 <stanton@GASPODE>
+ * 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/tclStubs.c:
- * generic/tclStubInit.c:
- * generic/tcl.decls: Removed Tcl_InitMemory().
+ * 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).
- * generic/tcl.h: Changed TCL_STUB_MAGIC to break binary
- compatibility with plus patch version, since the tables don't
- match.
+1999-03-31 <redman@scriptics.com>
-1999-03-08 <stanton@GASPODE>
+ * 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.
- * win/tclWinInt.h:
- * generic/tclInt.h:
- * generic/tclIntDecls.h:
- * generic/tclIntPlatDecls.h:
- * generic/tclIntPlatStubs.c:
- * generic/tclIntStubs.c:
- * generic/tclStubInit.c:
- * generic/tclInt.decls: Removed initialization and finalization
- routines from the stub table since these should never be called by
- an extension.
+1999-03-30 <stanton@scriptics.com>
-1999-03-06 <stanton@GASPODE>
+ * unix/Makefile.in: Removed trailing backslash that broke the
+ "depend" target.
- * unix/Makefile.in:
- * generic/tcl.decls:
- * generic/tclCompile.h:
- * generic/tclCompileDecls.h:
- * generic/tclCompileStubs.c:
+ * 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/tclInt.decls:
+ * 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/tclStubInit.c: Removed tclCompile.h functions. Moved
- TclGetAuxDataType to tclInt.h so it is available for use by
- the TclPro Byte Compiler loader.
-
-1999-03-05 <stanton@GASPODE>
-
- * unix/configure.in: Applied patch from Jan Nijtmans to fix the
- following problems:
- - There seems to be a HP-UX-11 already, which behaves
- identical to HP-UX-10.
- - For 64-bit IRIX, SHLIB_LD_LIBS should be set to
- '${LIBS}'. This also has the side-effect that SHLIB_LD
- doesn't need the -rpath option any more: it is already part
- of ${LIBS}
- - Fix Linux to use the -rpath option.
- - On Solaris, LD_SEARCH_FLAGS can only be used with the
- linker, not with the compiler, because the "-Wl," part is
- missing.
- - The TCL_LD_SEARCH_FLAGS should be used in static executables
- as well as dynamically linked ones. Otherwise, static
- executables have a different search strategy for dynamically
- loadable stub-enabled extensions than executables using
- shared libraries. This effects extensions which load other
- libraries in turn.
-
- * generic/tclCompile.h:
- * generic/tclStubInit.c:
- * generic/tclCompileDecls.h:
- * generic/tclCompileStubs.c:
- * generic/tclInt.decls: Added functions from tclCompile.h into a
- new tclCompile interface.
+ * 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]
- * generic/tclStubs.c:
+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/tcl.decls: Added Tcl_InitMemory.
+ * 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>
- * generic/tclStubLib.c: Changed to define USE_TCL_STUBS and
- USE_TCL_STUB_PROCS automatically.
+ * 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.
- * unix/Makefile.in: Changes to get stubs mechanism working.
+1999-03-26 <suresh@scriptics.com>
- * generic/tclGetDate.y: Updated to reflect tclDate.c changes.
+ * 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]
- * tools/genStubs.tcl:
+ * 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/tclTest.c:
- * unix/tclUnixFile.c:
- * unix/tclUnixPort.h: lint
+ * generic/tclStubs.c: Fixed bad eol characters.
+
+ * generic/tclInt.decls: Changed "const" to "CONST" in
+ declarations for better portability.
- * win/makefile.vc:
- * generic/tclAlloc.c: Changed USE_NATIVEMALLOC to USE_NATIVE_MALLOC.
+ * generic/tcl.decls: Renamed panic and panicVA to Tcl_Panic and
+ Tcl_PanicVA in the stub files.
-1999-03-03 <stanton@GASPODE>
+ * generic/tclInterp.c (Tcl_MakeSafe): Remove tcl_platform(user)
+ from safe interps.
- * unix/tclUnixTime.c: Added TclpGetDate and TclStrftime.
+1999-03-11 <stanton@GASPODE>
- * unix/tclUnixSock.c: Added TclHasSockets.
+ * 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.
- * unix/tclUnixPort.h: Eliminated various Tclp* macros that have
- been replaced with function defintions.
+1999-03-10 <stanton@GASPODE>
- * win/tclWinInt.h:
- * win/tclWin32Dll.c:
- * unix/tclUnixInit.c: Added TclpCheckStackSpace.
+ * 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.
- * unix/tclUnixFile.c:
- * mac/tclMacShLib.exp:
- * mac/tclMacFile.c:
- * generic/tclFileName.c:
- * win/tclWinFile.c: Renamed TclpGetUserHome back to
- TclGetUserHome for patch level compatibility.
+ * mac/tclMacNotify.c:
+ * generic/tclNotify.c:
+ * generic/tclInt.h:
+ * win/tclWinNotify.c:
+ * generic/tcl.h: Renamed Tcl_AlertNotifier to TclpAlertNotifier.
- * unix/tclUnixFile.c: Added TclpAccess and TclpState.
+ * generic/tclInt.decls: Added TclWinAddProcess to make it possible
+ for expect to use Tcl_WaitForPid(). This patch is from Gordon
+ Chaffee.
- * win/tclWinPort.h:
* mac/tclMacPort.h:
- * mac/tclMacInt.h:
- * mac/tclMac.h:
- * generic/tcl.decls: Added Mac specific declarations.
+ * 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>
- * mac/tclMacChan.c: Added stub implementation of
- Tcl_MakeFileChannel that doesn't do anything. This could be
- implemented at a later date.
+ * generic/tclCompile.h: Ensure that the ByteCode struct is binary
+ compatible with the version in 8.0.6.
- * generic/tclStubLib.c: Added internal interface hooks.
+ * 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>
- * generic/tclStubs.c:
- * generic/tclStubInit.c: Added undefs for all of the TCL_MEM_DEBUG
- macros to avoid conflicts with the stub names.
+ * Integrated changes from Tcl 8.0 including:
+ stubs mechanism
+ configure patches from Jan Nijtmans
+ rename of panic to Tcl_Panic
- * generic/tclStubInit.c:
- * generic/tclInt.h:
- * generic/tclInt.decls: Moved some declarations out of the generic
- and into the platform specific sections. Added missing
- declarations and Mac specific declarations.
+1999-03-08 <lfb@scriptics.com>
- * win/tclWinTime.c:
- * unix/tclUnixTime.c:
- * mac/tclMacTime.c:
- * generic/tclInt.h:
- * generic/tclDate.c:
- * generic/tclClock.c: Created a new opaque TclpTime_t type so
- generic functions that depend on the format of time_t can appear
- in the generic header files.
+ * win/tclWin32Dll.c: Removed Dll instance from thread-local
+ storage.
- * unix/Makefile.in:
- * generic/tclAlloc.c: Changed so stub versions of TclpAlloc,
- etc. are generated when TCL_MEM_DEBUG is not defined.
+1999-03-08 <stanton@GASPODE>
+
+ * generic/tcl.h: Moved Tcl_Mutex, etc. macros above the inclusion
+ of tclDecls.h to avoid macro conflicts.
- * generic/tclStubInit.c:
- * generic/tclPanic.c:
- * generic/tcl.h:
- * generic/tcl.decls: renamed Tcl_Panic back to panic to avoid
- incompatibilities in a patch release.
+ * 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:
-1999-03-02 <stanton@GASPODE>
+ * 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:
@@ -255,44 +593,399 @@
all platforms, even though it is currently a noop on mac and
windows, and renamed it to TclpGetUserHome.
- * generic/tclCkalloc.c: Added stub versions of memory checking
- functions when compiling without TCL_MEM_DEBUG.
+ * generic/tclPanic.c:
+ * generic/panic.c: Renamed panic to Tcl_Panic.
+
+1999-02-25 <redman@scriptics.com>
- * doc/ByteArrObj.3:
- * generic/tcl.h:
- * generic/tclBinary.c:
- * generic/tclObj.c: Ported the 8.1 ByteArray type back to 8.0.
+ * win/makefile.vc: Added tclWinConsole.c and tclWinSerial.c
- * generic/tcl.decls:
+ * 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/tclBasic.c:
- * generic/tclDecls.h:
- * generic/tclInt.decls:
+ * 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/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.
+ * 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.
-1999-02-27 <stanton@GASPODE>
+ * generic/tclCompile.c (TclCompileExprCmd): Eliminated yet another
+ bogus optimization in expression compilation.
- * generic/tclPanic.c:
- * generic/panic.c: renamed panic to Tcl_Panic, added macro for
- backwards compatibility, renamed file to tclPanic.c
+ * 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>
+
+ * Fixed lots of files that used TCL_THREAD instead of TCL_THREADS.
+
+ * generic/tclEncoding.c (Tcl_FreeEncoding): Moved most of the code
+ into a static FreeEncoding routine that does not grab the
+ encodingMutex to avoid deadlocks/races when called from other
+ routines that already have the mutex.
+
+1998-12-09 <stanton@GASPODE>
+
+ * library/msgcat1.0/msgcat.tcl: Fixed bad export list, fixed so
+ all locale strings are converted to lower case, including file
+ names.
+
+ * generic/regcomp.c (makescan): Fixed bug in longest match case
+ that caused anchored patterns to fail. [Bug: 897]
+
+1998-12-08 <stanton@GASPODE>
+
+ * library/msgcat1.0/msgcat.tcl: changed mc to invoke mcunknown in
+ the calling context, changed locale lookups to be case insensitive
+
+1998-12-07 <stanton@GASPODE>
+
+ * generic/tclAlloc.c (TclpRealloc): Fixed a memory allocation bug
+ where big blocks that were reallocated into a different heap
+ location were not being placed into the bigBlocks list. [Bug: 933]
+
+ * tests/msgcat.test: Added message catalog test suite.
+
+ * library/msgcat1.0/msgcat.tcl: minor bug fixes, integrated latest
+ changes from Mark Harrison.
+
+1998-12-04 <stanton@GASPODE>
+
+ * library/msgcat1.0/msgcat.tcl: Changed code to conform to Tcl
+ coding standards. Changed to use file join for portability.
+
+ * library/msgcat1.0: Added initial implementaion of Tcl message
+ catalog package contributed by Mark Harrison.
+
+1998-12-03 <stanton@GASPODE>
+
+ * win/tclWinPipe.c (BuildCommandLine): Fixed bug that kept
+ arguments containing spaces from being properly quoted.
+
+ * tests/defs: Changed so auto_path is set to only contain the Tcl
+ library directory. This keeps the tests from accidentally picking
+ up stuff in installed packages.
+
+ * generic/tclUtil.c (Tcl_StringMatch): Changed to match 8.0
+ behavior in corner case where there is no closing bracket.
+
+1998-12-02 <stanton@GASPODE>
+
+ * win/tclWinPipe.c (TclpCreateCommandChannel): Changed
+ reader/writer threads to have THREAD_PRIORITY_HIGHEST so they will
+ have a chance to run whenever there is something to do.
+
+ * generic/tclIO.c (WriteBytes, WriteChars): Fixed so extraneous
+ flushes do not happen in line mode.
+ (TranslateOutputEOL): Made translation more efficient in line mode
+ and fixed a buffer overflow bug in CRLF translation. [Bug: 887]
+
+1998-12-02 <welch@SAGE>
+
+ * Updated patchlevel to 8.1b1
+
+1998-12-02 <stanton@GASPODE>
+
+ * generic/regc_color.c (subcolor): Added check for error case to
+ avoid an out of bounds array reference.
+
+ * generic/tclCmdAH.c (Tcl_EncodingObjCmd): Changed to avoid using
+ Tcl_DStringResult because it is not binary clean.
+
+ * generic/tclParse.c (Tcl_ParseCommand): Fixed bug in comment
+ parsing where a trailing comment looked like an incomplete
+ command.
+
+1998-12-02 <welch@SAGE>
+
+ * Merged changes from 8.0.4, especially the new pkg_mkIndex
+
+1998-12-01 <stanton@GASPODE>
+
+ * generic/tclIO.c (Tcl_ReadChars): Added a call to UpdateInterest
+ so we don't block when there is data sitting in the buffers.
+
+ * generic/tclTest.c (TestevalobjvObjCmd): Updated for EvalObjv
+ change.
+
+ * tests/parse.test: Updated tests for EvalObjv change.
+
+ * generic/tclParse.c (EvalObjv, Tcl_EvalObjv): Changed
+ Tcl_EvalObjv interface to remove string and length arguments,
+ preserved original interface as EvalObjv for internal use.
+
+ * generic/tcl.h: Changed Tcl_EvalObjv interface to remove string
+ and length arguments.
+
+ * doc/Eval.3: Updated documentation for Tcl_EvalObjv to remove
+ string and length arguments.
+
+ * generic/tclCompCmds.c (TclCompileForeachCmd): Fixed code that
+ corrupted the exceptDepth value in the compile environment when
+ foreach failed to compile inline. [Bug: 884]
+
+ * library/encoding/euc-kr.enc:
+ * library/encoding/ksc5601.enc:
+ * tools/encoding/ksc5601.txt:
+ * unix/tclUnixInit.c: Added support for Korean EUC.
+
+ * win/tclWinChan.c (TclpGetDefaultStdChannel): added check for a
+ failure during Tcl_MakeFileChannel.
+
+1998-11-30 <stanton@GASPODE>
+
+ * unix/tclUnixNotfy.c (Tcl_WaitForEvent): Fixed hang that occurs
+ when trying to close a pipe that is currently being waited on by
+ the notifier thread. [Bug: 607]
+
+ * unix/tclUnixFCmd.c (GetPermissionsAttribute): Increase size of
+ returnString buffer to avoid overflow. [Bug: 584]
+
+ * generic/tclThreadTest.c (TclThreadSend): Fixed memory leak due
+ to use of TCL_VOLATILE instead of TCL_DYNAMIC.
+
+ * generic/tclThread.c (TclRememberSyncObject): Fixed memory leak
+ caused by failure to reuse condition variables.
+
+ * unix/tclUnixNotfy.c: (Tcl_AlertNotifier, Tcl_WaitForEvent,
+ NotifierThreadProc, Tcl_InitNotifier): Fixed race condition caused
+ by incorrect use of condition variables when sending messages
+ between threads.. [Bug: 607]
+
+ * generic/tclTestObj.c (TeststringobjCmd): MAX_STRINGS was off by one
+ so the strings array was too small.
+
+ * generic/tclCkalloc.c (Tcl_DbCkfree): Moved mutex lock so
+ ValidateMemory is done inside the mutex to avoid a race condition
+ when validate_memory is enabled. [Bug: 880]
+
+1998-11-23 <stanton@GASPODE>
+
+ * regexec.c: more performance tuning from Henry Spencer.
+
+1998-11-17 <stanton@GASPODE>
+
+ * tclScan.c: moved "scan" implementation out of tclCmdMZ.c and
+ added Unicode support. This required a complete reimplementation
+ of the command to avoid using scanf(), which isn't Unicode aware.
+ Two new features were added in the process: %n to return the
+ current number of characters consumed, and XPG3-style %n$ argument
+ order specifiers similar to those provided by the "format"
+ command. [Bug: 833]
+
+ * tclAlloc.c: changed so allocated memory is always 8-byte aligned
+ to improve memory performance and to ensure that it will work on
+ systems that don't like accessing 4-byte aligned values
+ (e.g. Solaris and HP-UX). [Bug: 834]
+
+1998-11-06 <stanton@GASPODE>
+
+ * tclVar.c (TclGetIndexedScalar): Fixed bug 796, var name was
+ getting lost before being passed to CallTraces.
+
+1998-10-21 <stanton@GASPODE>
+
+ * added "encoding" command
+
+ * Moved internal regexp declarations from tclInt.h to tclRegexp.h
+
+ * integrated regexp updates from Henry Spencer
+
+1998-10-15 <stanton@GASPODE>
+
+ * tclUtf.c: added Unicode character table support
+
+ * tclInt.h: added TclUniCharIsWordChar
+
+ * tclCmdMZ.c (Tcl_StringObjCmd): added "totitle" subcommand,
+ changed "wordend" and "wordstart" to properly handle Unicode word
+ characters and connector punctuation
+
+1998-10-05 <stanton@GASPODE>
+
+ * auto.tcl, package.tcl: fixed SCCS strings
+
+ * tclIndex: updated index to reflect 8.1 files
+
+ * tclCompile.c (TclCompileScript): changed to avoid modifying the
+ input string in place because name lookup operations could have
+ arbitrary side effects
+
+ * tclInterp.c: added guard against deleting current interpreter
+
+ * tclMacFile.c, tclUnixFile.c, tclWinFile.c, tclFileName.c: added
+ warnings around code that modifies strings in place
+
+ * tclExecute.c: fixed off-by-one copying error, fixed merge bugs
+
+ * tclEvent.c: changed so USE_TCLALLOC is tested for value instead
+ of definition
+
+ * tclCompCmds.c: replaced SCCS strings, added warnings around code
+ that modifies strings in place
+
+ * interp.test: added test for interp deleting itself
+
+1998-09-30 <stanton@GASPODE>
+
+ * makefile.vc: fixed so TCL_LIBRARY is set before running tcltest
+
+ * tclWin32Dll.c: removed TclpFinalize, cleanup of merges
diff --git a/README b/README
index ff54e6e..00e549d 100644
--- a/README
+++ b/README
@@ -3,14 +3,14 @@ README: Tcl
Tcl is maintained, enhanced, and distributed freely as a
service to the Tcl community by Scriptics Corporation.
-RCS: @(#) $Id: README,v 1.15 1999/02/26 22:25:04 hershey Exp $
+RCS: @(#) $Id: README,v 1.16 1999/04/16 00:46:29 stanton Exp $
Contents
--------
1. Introduction
2. Documentation
3. Compiling and installing Tcl
- 4. Summary of changes in Tcl 8.0
+ 4. Summary of changes in Tcl 8.1
5. Development tools
6. Tcl newsgroup
7. Tcl contributed archive
@@ -31,23 +31,23 @@ variety of web-related tasks and for creating powerful command
languages for applications.
This directory contains the sources and documentation for Tcl. The
-information here corresponds to release 8.0.5, which is the fifth
-patch update for Tcl 8.0. This patch provides bug fixes and
-incorporates user-contributed patches. Please check the changes file
-for details.
-
-Tcl 8.0 is a major 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.
+information here corresponds to release 8.1b3, which is the third
+beta release for Tcl 8.1. This release is mostly feature complete but
+may have bugs and be missing some minor features. This release is for
+early adopters who are willing to help us find and fix problems.
+Please let us know about any problems you uncover.
+
+Tcl 8.1 includes four major new features: Unicode support (all internal
+strings are now stored in UTF-8 form), a new regular expression matcher
+with most of the Perl features, support for multithreading, and a new
+message catalog package. For details on features, incompatibilities, and
+potential problems with this release, see the Tcl/Tk 8.1 Web page at
+http://www.scriptics.com/software/8.1.html or refer to the "changes" file
+in this directory, which contains a historical record of all changes to
+Tcl.
Tcl is a freely available open source package. You can do virtually
-anything you like with it, such as modifying it, redistributing it ,
+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.
@@ -143,138 +143,87 @@ compiling under UNIX, "win" if you're compiling under Windows, or
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
+4. Summary of changes in Tcl 8.1
--------------------------------
-Here are the most significant changes in Tcl 8.0. In addition to these
+Here are the most significant changes in Tcl 8.1. 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 Cadence.
- 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 following URL:
-
- http://www.scriptics.com/doc/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.
+ 1. Internationalization. Tcl has undergone a major revision to
+ support international character sets:
+
+ All strings in Tcl are now represented in UTF-8 instead of ASCII,
+ so that Tcl now supports the full Unicode character set. The
+ representation of ASCII characters is unchanged (in UTF-8 anything
+ that looks like an ASCII character is an ASCII character), but
+ characters with the high-order bit set, such as those in ISO-8859,
+ are represented with multi-byte sequences, as are all Unicode
+ characters with values greater than 127. This change does not
+ affect Tcl scripts but it does affect C code that parses strings.
+ Tcl automatically translates between UTF-8 and the normal encoding
+ for the platform during interactions with the system.
+
+ In Tcl scripts the backslash sequence \u can be used to enter
+ 16-bit Unicode characters. \o and \x generate only 8-bit
+ characters as before.
+
+ There is a new "encoding" command that allows scripts to determine
+ what encodings are available as well as to convert strings between
+ different encodings. 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.
+
+ There are several new C APIs that support UTF-8 and various
+ encodings. See the manual entry 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.
+
+ 2. Binary data. Binary data is handled differently in Tcl 8.1
+ than in Tcl 8.0. Tcl 8.1 uses the UTF-8 facilities to represent
+ binary data: the character value zero is represented with a
+ multi-byte sequence, so that (once again) strings in Tcl 8.1 never
+ contain null bytes. This means that binary data is now accepted
+ everywhere in Tcl and Tk (in Tcl 8.0 the support for binary data
+ was incomplete). If you have C code that needs to manipulate the
+ bytes of binary data (as opposed to just passing the data through)
+ you should use a new object type called "byte array". See the
+ manual entry ByteArrObj.3 for information about procedures such as
+ Tcl_GetByteArrayFromObj.
+
+ 3. Regular expressions. Tcl 8.1 contains a brand new
+ implementation of regular expressions from Henry Spencer. The
+ regular expression syntax has been greatly expanded to include
+ most of the features in Perl. In addition, the regexp engine
+ supports Unicode and binary data. See the doc/regexp.n manual
+ entry for more details.
+
+ 4. Threads. If configured with the --enable-threads flag, Tcl can
+ now be compiled for use in a multi-threaded application.
+ Individual threads are allowed to use one or more interpreters as
+ long as each interpreter (and any slave interpreters) is only
+ accessed by one thread. Each thread runs its own event loop, and
+ you can post events to other threads. There are new C APIs for
+ mutexes, condition variables, and thread local storage. See the
+ doc/Thread.3 manual entry for more details. Tk 8.1 is not yet
+ multi-thread safe. There is not yet support for tcl level use of
+ threading except for a test command. (Compile tcltest and try
+ testthread.)
+
+ 5. Message catalog. There is a new message catalog package which makes
+ it easy to localize the strings in a script. See the doc/msgcat.n
+ manual entry for more details.
+
+ 6. Stubbs library for building extensions. There is now a new
+ way to build extensions for Tcl. Instead of linking with the
+ tcl shared library you can now link to a stubs library that gets
+ built in this release. By linking with the stubs library it
+ is possible to use dynamically loaded extensions in staticlly
+ built applications. It will also be possible for some extensions
+ to work for both Tcl 8.0 & 8.1 with out having to recompile.
5. Development tools
--------------------
diff --git a/changes b/changes
index e46d87f..7ee8d72 100644
--- a/changes
+++ b/changes
@@ -1,6 +1,6 @@
Recent user-visible changes to Tcl:
-RCS: @(#) $Id: changes,v 1.42 1999/04/15 22:40:33 stanton Exp $
+RCS: @(#) $Id: changes,v 1.43 1999/04/16 00:46:29 stanton Exp $
1. No more [command1] [command2] construct for grouping multiple
commands on a single command line.
@@ -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
@@ -3655,7 +3655,7 @@ to update them to n32 for them to work with Tcl. (RJ)
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
+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
@@ -3668,18 +3668,18 @@ command. (BW)
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 equality explicitly. (JI)
+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 -----------------------
+----------------- Released 8.0.4, 11/19/98 -------------------------
11/20/98 (bug fix) Handle possible NULL return in TclGetStdFiles. (RJ)
@@ -3741,4 +3741,569 @@ 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 -----------------------
+----------------- 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) --nameble-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 ----------------------
+
diff --git a/compat/memcmp.c b/compat/memcmp.c
new file mode 100644
index 0000000..09a5724
--- /dev/null
+++ b/compat/memcmp.c
@@ -0,0 +1,61 @@
+/*
+ * memcmp.c --
+ *
+ * Source code for the "memcmp" library routine.
+ *
+ * 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: @(#) memcmp.c 1.2 98/01/19 10:48:58
+ */
+
+#include "tcl.h"
+#include "tclPort.h"
+
+/*
+ * Here is the prototype just in case it is not included
+ * in tclPort.h.
+ */
+
+int memcmp _ANSI_ARGS_((CONST VOID *s1,
+ CONST VOID *s2, size_t n));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * memcmp --
+ *
+ * Compares two bytes sequences.
+ *
+ * Results:
+ * compares its arguments, looking at the first n
+ * bytes (each interpreted as an unsigned char), and returns
+ * an integer less than, equal to, or greater than 0, accord-
+ * ing as s1 is less than, equal to, or
+ * greater than s2 when taken to be unsigned 8 bit numbers.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+memcmp(s1, s2, n)
+ CONST VOID *s1; /* First string. */
+ CONST VOID *s2; /* Second string. */
+ size_t n; /* Length to compare. */
+{
+ unsigned char u1, u2;
+
+ for ( ; n-- ; s1++, s2++) {
+ u1 = * (unsigned char *) s1;
+ u2 = * (unsigned char *) s2;
+ if ( u1 != u2) {
+ return (u1-u2);
+ }
+ }
+ return 0;
+}
diff --git a/compat/stdlib.h b/compat/stdlib.h
index a9f30bc..6edeeae 100644
--- a/compat/stdlib.h
+++ b/compat/stdlib.h
@@ -9,12 +9,12 @@
* 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.
*
- * RCS: @(#) $Id: stdlib.h,v 1.2 1998/09/14 18:39:45 stanton Exp $
+ * RCS: @(#) $Id: stdlib.h,v 1.3 1999/04/16 00:46:30 stanton Exp $
*/
#ifndef _STDLIB
diff --git a/compat/strftime.c b/compat/strftime.c
index e99a046..d588433 100644
--- a/compat/strftime.c
+++ b/compat/strftime.c
@@ -8,7 +8,7 @@
* source. See the copyright notice below for details on redistribution
* restrictions. The "license.terms" file does not apply to this file.
*
- * RCS: @(#) $Id: strftime.c,v 1.2 1998/09/14 18:39:45 stanton Exp $
+ * RCS: @(#) $Id: strftime.c,v 1.3 1999/04/16 00:46:30 stanton Exp $
*/
/*
@@ -45,7 +45,7 @@
*/
#if defined(LIBC_SCCS)
-static char *rcsid = "$Id: strftime.c,v 1.2 1998/09/14 18:39:45 stanton Exp $";
+static char *rcsid = "$Id: strftime.c,v 1.3 1999/04/16 00:46:30 stanton Exp $";
#endif /* LIBC_SCCS */
#include <time.h>
@@ -105,7 +105,7 @@ 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;
@@ -315,7 +315,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/compat/string.h b/compat/string.h
index a4df8ab..b7a0653 100644
--- a/compat/string.h
+++ b/compat/string.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: string.h,v 1.2 1998/09/14 18:39:45 stanton Exp $
+ * RCS: @(#) $Id: string.h,v 1.3 1999/04/16 00:46:30 stanton Exp $
*/
#ifndef _STRING
@@ -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/doc/AssocData.3 b/doc/AssocData.3
index 4ff36c8..9b68c43 100644
--- a/doc/AssocData.3
+++ b/doc/AssocData.3
@@ -5,7 +5,7 @@
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\"
-'\" RCS: @(#) $Id: AssocData.3,v 1.2 1998/09/14 18:39:46 stanton Exp $
+'\" RCS: @(#) $Id: AssocData.3,v 1.3 1999/04/16 00:46:30 stanton Exp $
.so man.macros
.TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures"
.BS
@@ -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/doc/Async.3 b/doc/Async.3
index 1c245cb..5086557 100644
--- a/doc/Async.3
+++ b/doc/Async.3
@@ -5,13 +5,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Async.3,v 1.2 1998/09/14 18:39:46 stanton Exp $
+'\" RCS: @(#) $Id: Async.3,v 1.3 1999/04/16 00:46:30 stanton Exp $
'\"
.so man.macros
.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
diff --git a/doc/Backslash.3 b/doc/Backslash.3
index 382e8f2..95fc7e8 100644
--- a/doc/Backslash.3
+++ b/doc/Backslash.3
@@ -5,10 +5,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Backslash.3,v 1.2 1998/09/14 18:39:46 stanton Exp $
+'\" RCS: @(#) $Id: Backslash.3,v 1.3 1999/04/16 00:46:30 stanton Exp $
'\"
.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/doc/CrtChannel.3 b/doc/CrtChannel.3
index daef201..dc0f91b 100644
--- a/doc/CrtChannel.3
+++ b/doc/CrtChannel.3
@@ -4,13 +4,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtChannel.3,v 1.2 1998/09/14 18:39:46 stanton Exp $
+'\" RCS: @(#) $Id: CrtChannel.3,v 1.3 1999/04/16 00:46:30 stanton Exp $
.so man.macros
.TH Tcl_CreateChannel 3 8.0 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 \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -33,11 +33,6 @@ int
.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)
@@ -170,13 +165,7 @@ for each driver to determine what type of handle is returned.
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.
@@ -221,16 +210,19 @@ typedef struct Tcl_ChannelType {
Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
Tcl_DriverWatchProc *\fIwatchProc\fR;
Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
+ Tcl_DriverClose2Proc *\fIclose2Proc\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,
+.VS
+\fIgetOptionProc\fR, and \fIclose2Proc\fR, which may be specified as
+.VE
+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.
.SH TYPENAME
.PP
@@ -264,7 +256,7 @@ 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.
-.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
@@ -286,6 +278,35 @@ 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.
+.PP
+.VS
+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 \fIinterp->result\fR.
+.VE
.SH INPUTPROC
.PP
@@ -382,7 +403,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
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 4390ef0..756b970 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtObjCmd.3,v 1.2 1998/09/14 18:39:47 stanton Exp $
+'\" RCS: @(#) $Id: CrtObjCmd.3,v 1.3 1999/04/16 00:46:30 stanton Exp $
'\"
.so man.macros
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
@@ -62,8 +62,10 @@ such that whenever \fIname\fR is
invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObj\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.
@@ -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,
diff --git a/doc/Encoding.3 b/doc/Encoding.3
new file mode 100644
index 0000000..e9329dd
--- /dev/null
+++ b/doc/Encoding.3
@@ -0,0 +1,484 @@
+'\"
+'\" 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: Encoding.3,v 1.2 1999/04/16 00:46:31 stanton Exp $
+'\"
+.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_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
+void
+\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
+void
+\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_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 functions, an array of UTF-8 characters to be
+converted to the specified encoding.
+.AP int srcLen in
+Length of \fIsrc\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.
+.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.
+.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_GetEncodingName\fR is roughly the inverse of \fBTk_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/doc/Eval.3 b/doc/Eval.3
index 42e77ae..bc0effc 100644
--- a/doc/Eval.3
+++ b/doc/Eval.3
@@ -5,97 +5,173 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Eval.3,v 1.3 1999/03/10 05:52:45 stanton Exp $
+'\" RCS: @(#) $Id: Eval.3,v 1.4 1999/04/16 00:46:31 stanton Exp $
'\"
.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_VarEvalVA, 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_VarEvalVA\fR(\fIinterp, argList\fR)
+\fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR)
.sp
int
-\fBTcl_EvalFile\fR(\fIinterp, fileName\fR)
+\fBTcl_Eval\fR(\fIinterp, script\fR)
+.sp
+int
+\fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR)
+.sp
+int
+\fBTcl_GlobalEval\fR(\fIinterp, script\fR)
.sp
int
-\fBTcl_GlobalEval\fR(\fIinterp, cmd\fR)
+\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).
+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 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 Tcl command.
+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.
-.AP char *fileName in
-Name of file containing Tcl command string.
.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
+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_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
-instead of taking a variable number of arguments it takes an argument list.
-.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.
+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.
@@ -103,21 +179,18 @@ 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/doc/EvalObj.3 b/doc/EvalObj.3
deleted file mode 100644
index 9948196..0000000
--- a/doc/EvalObj.3
+++ /dev/null
@@ -1,91 +0,0 @@
-'\"
-'\" 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.
-'\"
-'\" RCS: @(#) $Id: EvalObj.3,v 1.2 1998/09/14 18:39:48 stanton Exp $
-'\"
-.so man.macros
-.TH Tcl_EvalObj 3 8.0 Tcl "Tcl Library Procedures"
-.BS
-.SH NAME
-Tcl_EvalObj, Tcl_GlobalEvalObj \- execute Tcl commands
-.SH SYNOPSIS
-.nf
-\fB#include <tcl.h>\fR
-.sp
-int
-\fBTcl_EvalObj\fR(\fIinterp, objPtr\fR)
-.sp
-int
-\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR)
-.SH ARGUMENTS
-.AS Tcl_Interp **termPtr;
-.AP Tcl_Interp *interp in
-Interpreter in which to execute the command.
-The command's result will be stored in the interpreter's result object
-and can be retrieved using \fBTcl_GetObjResult\fR.
-.AP Tcl_Obj *objPtr in
-A Tcl object containing a command string
-(or sequence of commands in a string) to execute.
-.BE
-
-.SH DESCRIPTION
-.PP
-These two procedures execute Tcl commands.
-\fBTcl_EvalObj\fR is the core procedure
-and is used by \fBTcl_GlobalEvalObj\fR.
-It executes the commands in the script held by \fIobjPtr\fR
-until either an error occurs or it reaches the end of the script.
-If this is the first time \fIobjPtr\fR has been executed,
-its commands are compiled into bytecode instructions
-that are then executed if there are no compilation errors.
-.PP
-The return value from \fBTcl_EvalObj\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 a result object containing additional information
-(a result value or error message)
-that can be retrieved using \fBTcl_GetObjResult\fR.
-If an error occurs during compilation, this return information
-describes the error.
-Otherwise, this return information corresponds to the last command
-executed from \fIobjPtr\fR.
-.PP
-\fBTcl_GlobalEvalObj\fR is similar to \fBTcl_EvalObj\fR except that it
-processes the command at global level.
-This means that the variable context for the command consists of
-global variables only (it ignores any Tcl procedure that is active).
-This produces an effect similar to the Tcl command ``\fBuplevel 0\fR''.
-.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_EvalObj\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.
-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_EvalObj\fR keeps track of how many nested \fBTcl_EvalObj\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_EvalObj\fR
-invocation for \fIinterp\fR,
-it converts the return code to \fBTCL_ERROR\fR
-and sets the interpreter's result object
-to point 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_EvalObj\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
-
-.SH "SEE ALSO"
-Tcl_GetObjResult, Tcl_SetObjResult
-
-.SH KEYWORDS
-command, execute, file, global, object, object result, variable
diff --git a/doc/Exit.3 b/doc/Exit.3
index b3f2ca6..c533efe 100644
--- a/doc/Exit.3
+++ b/doc/Exit.3
@@ -4,13 +4,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Exit.3,v 1.2 1998/09/14 18:39:48 stanton Exp $
+'\" RCS: @(#) $Id: Exit.3,v 1.3 1999/04/16 00:46:31 stanton Exp $
'\"
.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_FinalizeThread, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, 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,14 @@ 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/doc/GetCwd.3 b/doc/GetCwd.3
new file mode 100755
index 0000000..4c8d65d
--- /dev/null
+++ b/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: GetCwd.3,v 1.2 1999/04/16 00:46:31 stanton Exp $
+'\"
+.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/doc/GetIndex.3 b/doc/GetIndex.3
index 4cacdb2..342069a 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -4,10 +4,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: GetIndex.3,v 1.2 1998/09/14 18:39:48 stanton Exp $
+'\" RCS: @(#) $Id: GetIndex.3,v 1.3 1999/04/16 00:46:31 stanton Exp $
'\"
.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
@@ -16,7 +16,14 @@ Tcl_GetIndexFromObj \- lookup string in table of keywords
\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,7 +80,18 @@ 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.
+.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
diff --git a/doc/CrtVersion.3 b/doc/GetVersion.3
index 4333786..0b88dc5 100644..100755
--- a/doc/CrtVersion.3
+++ b/doc/GetVersion.3
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: CrtVersion.3,v 1.2 1999/03/11 19:29:34 redman Exp $
+'\" RCS: @(#) $Id: GetVersion.3,v 1.2 1999/04/16 00:46:32 stanton Exp $
'\"
.so man.macros
.TH Tcl_GetVersion 3 7.5 Tcl "Tcl Library Procedures"
@@ -15,7 +15,7 @@ Tcl_GetVersion \- get the version of the library at runtime
.nf
\fB#include <tcl.h>\fR
.sp
-\fBTcl_GetVersion\fR(\fmajor, minor, patchLevel, type\fR)
+\fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR)
.SH ARGUMENTS
.AP int *major out
Major version number of the Tcl library.
@@ -41,8 +41,8 @@ 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\fI of the library, pass
-a NULL for the \fIpatchLevel\fI argument.
+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/doc/ObjSetVar.3 b/doc/ObjSetVar.3
deleted file mode 100644
index e34f9d3..0000000
--- a/doc/ObjSetVar.3
+++ /dev/null
@@ -1,162 +0,0 @@
-'\"
-'\" 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.
-'\"
-'\" RCS: @(#) $Id: ObjSetVar.3,v 1.2 1998/09/14 18:39:49 stanton Exp $
-'\"
-.so man.macros
-.TH Tcl_ObjSetVar2 3 8.0 Tcl "Tcl Library Procedures"
-.BS
-.SH NAME
-Tcl_ObjSetVar2, Tcl_ObjGetVar2 \- manipulate Tcl variables
-.SH SYNOPSIS
-.nf
-\fB#include <tcl.h>\fR
-.sp
-Tcl_Obj *
-\fBTcl_ObjSetVar2\fR(\fIinterp, part1Ptr, part2Ptr, newValuePtr, flags\fR)
-.sp
-Tcl_Obj *
-\fBTcl_ObjGetVar2\fR(\fIinterp, part1Ptr, part2Ptr, flags\fR)
-.SH ARGUMENTS
-.AS Tcl_Interp *newValuePtr
-.AP Tcl_Interp *interp in
-Interpreter containing 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.
-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.
-.AP Tcl_Obj *newValuePtr in
-Points to a Tcl object containing the new value for the variable.
-.AP int flags in
-OR-ed combination of bits providing additional information for
-operation. See below for valid values.
-.BE
-
-.SH DESCRIPTION
-.PP
-These two procedures may be used to read and modify
-Tcl variables from C code.
-\fBTcl_ObjSetVar2\fR will create a new variable or modify an existing one.
-It sets the specified variable to
-the object referenced by \fInewValuePtr\fR
-and returns a pointer to the object which is the variable's new value.
-The returned object may not be the same one
-referenced by \fInewValuePtr\fR;
-this might happen because variable traces may modify the variable's value.
-The reference count for the variable's old value is decremented
-and the reference count for its new value is incremented.
-If the new value for the variable
-is not the same one referenced by \fInewValuePtr\fR
-(perhaps as a result of a variable trace),
-then \fInewValuePtr\fR's reference count is left unchanged.
-The reference count for the returned object is not incremented
-to reflect the returned reference.
-If the caller needs to keep a reference to the object,
-say in a data structure,
-it must increment its reference count using \fBTcl_IncrRefCount\fR.
-If an error occurs in setting the variable
-(e.g. an array variable is referenced
-without giving an index into the array),
-then NULL is returned.
-.PP
-The variable name specified to \fBTcl_ObjSetVar2\fR consists of two parts.
-\fIpart1Ptr\fR contains the name of a scalar or array variable.
-If \fIpart2Ptr\fR is NULL, the variable must be a scalar.
-If \fIpart2Ptr\fR is not NULL,
-it contains the name of an element in the array named by \fIpart2Ptr\fR.
-As a special case, if the flag TCL_PARSE_PART1 is specified,
-\fIpart1Ptr\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,
-\fIpart2Ptr\fR should be NULL since the array and element names
-are taken from \fIpart2Ptr\fR.
-.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 any of the following
-bits:
-.TP
-\fBTCL_GLOBAL_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 global namespace
-even if there is a procedure call active.
-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.
-.TP
-\fBTCL_LEAVE_ERR_MSG\fR
-If an error is returned and this bit is set in \fIflags\fR, then
-an error message will be left in the interpreter's result,
-where it can be retrieved with \fBTcl_GetObjResult\fR
-or \fBTcl_GetStringResult\fR.
-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 \fInewValuePtr\fR is appended to the current
-value, instead of replacing it.
-If the variable is currently undefined, then this bit is ignored.
-.TP
-\fBTCL_LIST_ELEMENT\fR
-If this bit is set, then \fInewValuePtr\fR is converted to a valid
-Tcl list element before setting (or appending to) the variable.
-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,
-then \fBTcl_ObjGetVar2\fR and \fBTcl_ObjSetVar2\fR
-will parse \fIpart1Ptr\fR
-to obtain both an array name and an element name.
-If the name in \fIpart1Ptr\fR contains an open parenthesis
-and ends with a close parenthesis,
-the name is treated as the name of an element of an array;
-otherwise, the name in \fIpart1Ptr\fR
-is interpreted as the name of a scalar variable.
-When this bit is set,
-\fIpart2Ptr\fR is ignored.
-.PP
-\fBTcl_ObjGetVar2\fR returns the value of the specified variable.
-Its arguments are treated the same way as those for \fBTcl_ObjSetVar2\fR.
-It returns a pointer to the object which is the variable's value.
-The reference count for the returned object is not incremented.
-If the caller needs to keep a reference to the object,
-say in a data structure,
-it must increment the reference count using \fBTcl_IncrRefCount\fR.
-If an error occurs in setting the variable
-(e.g. an array variable is referenced
-without giving an index into the array),
-then NULL is returned.
-
-.SH "SEE ALSO"
-Tcl_GetObjResult, Tcl_GetStringResult, Tcl_GetVar, Tcl_GetVar2, Tcl_SetVar, Tcl_SetVar2, Tcl_TraceVar, Tcl_UnsetVar, Tcl_UnsetVar2
-
-.SH KEYWORDS
-array, interpreter, object, scalar, set, unset, variable
diff --git a/doc/Object.3 b/doc/Object.3
index da9c3cd..214695f 100644
--- a/doc/Object.3
+++ b/doc/Object.3
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Object.3,v 1.2 1998/09/14 18:39:49 stanton Exp $
+'\" RCS: @(#) $Id: Object.3,v 1.3 1999/04/16 00:46:32 stanton Exp $
'\"
.so man.macros
.TH Tcl_Obj 3 8.0 Tcl "Tcl Library Procedures"
@@ -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
diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3
index c0d121c..e9205e3 100644
--- a/doc/OpenFileChnl.3
+++ b/doc/OpenFileChnl.3
@@ -4,13 +4,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: OpenFileChnl.3,v 1.2 1998/09/14 18:39:49 stanton Exp $
+'\" RCS: @(#) $Id: OpenFileChnl.3,v 1.3 1999/04/16 00:46:32 stanton Exp $
.so man.macros
-.TH Tcl_OpenFileChannel 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_OpenFileChannel 3 8.1 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_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, \- 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)
@@ -40,17 +40,28 @@ 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_WriteObj\fR(\fIchannel, writeObjPtr\fR)
+.sp
+int
+\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
+.sp
+int
+\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
+.VE
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)
@@ -83,37 +94,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 +132,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
@@ -169,7 +193,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 +206,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 +214,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.
@@ -310,93 +334,136 @@ left in \fIinterp->result\fR.
.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_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 +486,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
@@ -477,7 +544,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
diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3
new file mode 100644
index 0000000..2a180a6
--- /dev/null
+++ b/doc/ParseCmd.3
@@ -0,0 +1,426 @@
+'\"
+'\" 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: ParseCmd.3,v 1.2 1999/04/16 00:46:32 stanton Exp $
+'\"
+.so man.macros
+.TH Tcl_ParseCommand 3 8.1 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, 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
+\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 and \fBTcl_ParseQuotedString\fR
+will store a pointer to the character
+just after the terminating close-brace or 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
+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/doc/RegExp.3 b/doc/RegExp.3
index 61778cd..1f1064d 100644
--- a/doc/RegExp.3
+++ b/doc/RegExp.3
@@ -1,21 +1,25 @@
'\"
'\" 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.
'\"
-'\" RCS: @(#) $Id: RegExp.3,v 1.2 1998/09/14 18:39:50 stanton Exp $
+'\" RCS: @(#) $Id: RegExp.3,v 1.3 1999/04/16 00:46:32 stanton Exp $
'\"
.so man.macros
.TH Tcl_RegExpMatch 3 7.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
-Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern matching with regular expressions
+Tcl_GetRegExpFromObj, Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern matching with regular expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
+Tcl_RegExp
+\fBTcl_GetRegExpFromObj\fR(\fIinterp\fR, \fIpatObj\fR, \fIflags\fR)
+.sp
int
\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR)
.sp
@@ -34,9 +38,13 @@ Tcl interpreter to use for error reporting.
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_Obj *patObj in
+Refers to the object from which to get a compiled regular expression.
+.AP int flags in
+Various flags to control regular expression compile options.
.AP Tcl_RegExp regexp in
Compiled regular expression. Must have been returned previously
-by \fBTcl_RegExpCompile\fR.
+by \fBTcl_GetRegExpFromObj\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.
@@ -56,6 +64,13 @@ is stored here, or NULL if there is no such range.
.SH DESCRIPTION
.PP
+\fBTcl_GetRegExpFromObj\fR attepts to return a compiled regular
+expression from the Tcl obj \fIpatObj\fR. If the object does not
+already contain a compiled regular expression it will attempt to
+create one from the string in the Tcl obj and assign it to the
+internal representation of the \fIpatObj\fR. The return value
+of this function is of type \fBTcl_RegExp\fR.
+.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
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
new file mode 100644
index 0000000..6a0a051
--- /dev/null
+++ b/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: SaveResult.3,v 1.2 1999/04/16 00:46:33 stanton Exp $
+'\"
+.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/doc/SetRecLmt.3 b/doc/SetRecLmt.3
index b41985b..599e46f 100644
--- a/doc/SetRecLmt.3
+++ b/doc/SetRecLmt.3
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetRecLmt.3,v 1.2 1998/09/14 18:39:50 stanton Exp $
+'\" RCS: @(#) $Id: SetRecLmt.3,v 1.3 1999/04/16 00:46:33 stanton Exp $
'\"
.so man.macros
.TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures"
@@ -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/doc/SetVar.3 b/doc/SetVar.3
index 70100f4..bb07005 100644
--- a/doc/SetVar.3
+++ b/doc/SetVar.3
@@ -5,93 +5,158 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: SetVar.3,v 1.2 1998/09/14 18:39:50 stanton Exp $
+'\" RCS: @(#) $Id: SetVar.3,v 1.3 1999/04/16 00:46:33 stanton Exp $
'\"
.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/doc/StringObj.3 b/doc/StringObj.3
index 94cd142..46fe959 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -4,13 +4,13 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: StringObj.3,v 1.3 1999/03/10 05:52:45 stanton Exp $
+'\" RCS: @(#) $Id: StringObj.3,v 1.4 1999/04/16 00:46:33 stanton Exp $
'\"
.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_AppendStringsToObjVA, Tcl_SetObjLength, TclConcatObj \- manipulate Tcl objects as strings
+Tcl_NewStringObj, Tcl_SetStringObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_AppendToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendObjToObj, Tcl_SetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -23,7 +23,14 @@ Tcl_Obj *
char *
\fBTcl_GetStringFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
+char *
+\fBTcl_GetString\fR(\fIobjPtr\fR)
+.sp
\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)
+.VS
+.sp
+\fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR)
+.VE
.sp
\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
.sp
@@ -34,7 +41,7 @@ char *
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.
@@ -46,6 +53,10 @@ initializing, setting, or appending to a string object.
If negative, all bytes up to the first null are used.
.AP Tcl_Obj *objPtr in/out
Points to an object to manipulate.
+.VS
+.AP Tcl_Obj *appendObjPtr in
+The object to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
+.VE
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the the length of an object's string representation.
@@ -81,21 +92,30 @@ 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.
.PP
-\fBTcl_GetStringFromObj\fR returns an object's string representation.
+\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR
+return 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.
+and (for \fBTcl_GetStringFromObj\fR) 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.
+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_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).
+.VS
+.PP
+\fBTcl_AppendObjToObj\fR is similar to \fBTcl_AppendToObj\fR, but it
+appends the string value 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
diff --git a/doc/Tcl.n b/doc/Tcl.n
index ee71cf5..6bd8511 100644
--- a/doc/Tcl.n
+++ b/doc/Tcl.n
@@ -5,10 +5,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: Tcl.n,v 1.2 1998/09/14 18:39:50 stanton Exp $
-'
+'\" RCS: @(#) $Id: Tcl.n,v 1.3 1999/04/16 00:46:33 stanton Exp $
+'\"
.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/doc/Thread.3 b/doc/Thread.3
new file mode 100644
index 0000000..595fac3
--- /dev/null
+++ b/doc/Thread.3
@@ -0,0 +1,100 @@
+'\"
+'\" 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: Thread.3,v 1.2 1999/04/16 00:46:33 stanton Exp $
+'\"
+.so man.macros
+.TH Tcl_ConditionNotify 3 "8.1" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock \- thread synchronization 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_GetThreadData\fR(\fIkeyPtr, size\fR)
+.sp
+void
+\fBTcl_MutexLock\fR(\fImutexPtr\fR)
+.sp
+void
+\fBTcl_MutexUnlock\fR(\fImutexPtr\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.
+.BE
+
+.SH DESCRIPTION
+.PP
+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
+The result of locking a mutex twice from the same thread is undefined.
+On some platforms it will result in a deadlock.
+.VE
+\fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\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
+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
+.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
+cleaned up by process exit handlers. 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 KEYWORDS
+thread, mutex, condition variable, thread local storage
diff --git a/doc/ToUpper.3 b/doc/ToUpper.3
new file mode 100644
index 0000000..639dd61
--- /dev/null
+++ b/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: ToUpper.3,v 1.2 1999/04/16 00:46:33 stanton Exp $
+'\"
+.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/doc/TraceVar.3 b/doc/TraceVar.3
index ac4891d..57a3350 100644
--- a/doc/TraceVar.3
+++ b/doc/TraceVar.3
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: TraceVar.3,v 1.2 1998/09/14 18:39:50 stanton Exp $
+'\" RCS: @(#) $Id: TraceVar.3,v 1.3 1999/04/16 00:46:33 stanton Exp $
'\"
.so man.macros
.TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
@@ -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
@@ -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,9 @@ 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/doc/Translate.3 b/doc/Translate.3
index e57d7f3..5d0d598 100644
--- a/doc/Translate.3
+++ b/doc/Translate.3
@@ -1,14 +1,14 @@
'\"
'\" 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.
'\"
-'\" RCS: @(#) $Id: Translate.3,v 1.2 1998/09/14 18:39:51 stanton Exp $
+'\" RCS: @(#) $Id: Translate.3,v 1.3 1999/04/16 00:46:33 stanton Exp $
'\"
.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
diff --git a/doc/Utf.3 b/doc/Utf.3
new file mode 100644
index 0000000..f68a6cb
--- /dev/null
+++ b/doc/Utf.3
@@ -0,0 +1,160 @@
+'\"
+'\" 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: Utf.3,v 1.2 1999/04/16 00:46:34 stanton Exp $
+'\"
+.so man.macros
+.TH Utf 3 "8.1" Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, 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
+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 char" *chPtr 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 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 "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_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.
+.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.
+.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/doc/binary.n b/doc/binary.n
index 871182e..8b20259 100644
--- a/doc/binary.n
+++ b/doc/binary.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: binary.n,v 1.2 1998/09/14 18:39:51 stanton Exp $
+'\" RCS: @(#) $Id: binary.n,v 1.3 1999/04/16 00:46:34 stanton Exp $
'\"
.so man.macros
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
@@ -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
@@ -318,7 +318,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 +338,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 +365,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
diff --git a/doc/catch.n b/doc/catch.n
index 17b5c1d..23771f9 100644
--- a/doc/catch.n
+++ b/doc/catch.n
@@ -5,10 +5,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: catch.n,v 1.2 1998/09/14 18:39:51 stanton Exp $
+'\" RCS: @(#) $Id: catch.n,v 1.3 1999/04/16 00:46:34 stanton Exp $
'\"
.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,52 @@ 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.
+
+.DS
+.CS
+if { [catch {open $someFile w} fid] } {
+ puts stderr "Could not open $someFile for writing\\n$fid"
+ exit 1
+}
+.CE
+.DE
+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.
+
+.DS
+.CS
+proc foo {} {
+ catch {expr {1 +- }}
+}
+.CE
+.DE
.SH KEYWORDS
catch, error
diff --git a/doc/dde.n b/doc/dde.n
new file mode 100644
index 0000000..c9797a6
--- /dev/null
+++ b/doc/dde.n
@@ -0,0 +1,124 @@
+'\"
+'\" 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: dde.n,v 1.2 1999/04/16 00:46:34 stanton Exp $
+'\"
+.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.0\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 TclEval and the topic name specified byt \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 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
+"TclEval" service. This command can be used to replace send on Windows.
+.SH "DDE AND TCL"
+A Tcl interpreter always has a service name of "TclEval". Each
+different interp of all running Tcl applications should 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 "$TCLEVAL$EXECUTE$RESULT"
+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 KEYWORDS
+application, dde, name, remote execution
+.SH "SEE ALSO"
+tk, winfo, send
+
diff --git a/doc/encoding.n b/doc/encoding.n
new file mode 100644
index 0000000..fc6d4f7
--- /dev/null
+++ b/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: encoding.n,v 1.2 1999/04/16 00:46:34 stanton Exp $
+'\"
+.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/doc/exec.n b/doc/exec.n
index 0d6db95..f30f6b0 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: exec.n,v 1.2 1998/09/14 18:39:52 stanton Exp $
+'\" RCS: @(#) $Id: exec.n,v 1.3 1999/04/16 00:46:34 stanton Exp $
'\"
.so man.macros
.TH exec n 7.6 Tcl "Tcl Built-In Commands"
@@ -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
diff --git a/doc/fconfigure.n b/doc/fconfigure.n
index 720b206..e2479e8a 100644
--- a/doc/fconfigure.n
+++ b/doc/fconfigure.n
@@ -4,10 +4,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: fconfigure.n,v 1.2 1998/09/14 18:39:52 stanton Exp $
+'\" RCS: @(#) $Id: fconfigure.n,v 1.3 1999/04/16 00:46:34 stanton Exp $
'\"
.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,143 @@ 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.
.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 +196,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/doc/format.n b/doc/format.n
index 8161ee6..9f737e0 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: format.n,v 1.2 1998/09/14 18:39:52 stanton Exp $
+'\" RCS: @(#) $Id: format.n,v 1.3 1999/04/16 00:46:34 stanton Exp $
'\"
.so man.macros
.TH format n "" Tcl "Tcl Built-In Commands"
@@ -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/doc/glob.n b/doc/glob.n
index 3bddcc8..47c4e50 100644
--- a/doc/glob.n
+++ b/doc/glob.n
@@ -5,10 +5,10 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: glob.n,v 1.2 1998/09/14 18:39:52 stanton Exp $
+'\" RCS: @(#) $Id: glob.n,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
-.TH glob n 7.5 Tcl "Tcl Built-In Commands"
+.TH glob n 8.1 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
@@ -76,9 +76,18 @@ contains a ?, *, or [] construct.
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.
+.VS 8.1
+.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.
+.VE
.SH KEYWORDS
exist, file, glob, pattern
diff --git a/doc/http.n b/doc/http.n
index 79ff5e9..7fd61ce 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: http.n,v 1.2 1998/09/14 18:39:53 stanton Exp $
+'\" RCS: @(#) $Id: http.n,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
.TH "Http" n 8.0 Tcl "Tcl Built-In Commands"
@@ -250,7 +250,9 @@ 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 following elements of
+the array are supported:
.RS
.TP
\fBbody\fR
diff --git a/doc/library.n b/doc/library.n
index a760c04..eb20351 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: library.n,v 1.5 1998/10/30 23:02:02 welch Exp $
+'\" RCS: @(#) $Id: library.n,v 1.6 1999/04/16 00:46:35 stanton Exp $
.so man.macros
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.BS
@@ -60,16 +60,18 @@ 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_load \fIcmd\fR
This command attempts to load the definition for a Tcl command named
diff --git a/doc/man.macros b/doc/man.macros
index 86525bd..bdf69ff 100644
--- a/doc/man.macros
+++ b/doc/man.macros
@@ -59,7 +59,7 @@
'\" .UL arg1 arg2
'\" Print arg1 underlined, then print arg2 normally.
'\"
-'\" RCS: @(#) $Id: man.macros,v 1.2 1998/09/14 18:39:54 stanton Exp $
+'\" RCS: @(#) $Id: man.macros,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
.if t .wh -1.3i ^B
@@ -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/doc/msgcat.n b/doc/msgcat.n
new file mode 100644
index 0000000..e04d2a6
--- /dev/null
+++ b/doc/msgcat.n
@@ -0,0 +1,207 @@
+'\"
+'\" 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 src-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 src-string\fR
+Returns a translation of \fIsrc-string\fR according to the
+user's current locale. 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 new locale
+is returned. 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
+return \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\fB procedure is invoked at the
+same stack context as the call to \fB::msgcat::mc\fR. The return vaue
+of \fB::msgcat::mcunknown\fB 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
+
+.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 "SEE ALSO"
+format(n), scan(n), namespace(n), package(n)
+
+.SH CREDITS
+.PP
+The message catalog code was developed by Mark Harrison.
+.SH KEYWORDS
+internationalization, i18n, localization, l10n, message, text, translation
diff --git a/doc/namespace.n b/doc/namespace.n
index a8b6b16..eeb45f5 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: namespace.n,v 1.2 1998/09/14 18:39:54 stanton Exp $
+'\" RCS: @(#) $Id: namespace.n,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
.TH namespace n 8.0 Tcl "Tcl Built-In Commands"
@@ -245,21 +245,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 +276,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 +322,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 +332,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 +517,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/doc/open.n b/doc/open.n
index 76d0b1c..03e4339 100644
--- a/doc/open.n
+++ b/doc/open.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: open.n,v 1.3 1999/04/15 22:38:46 stanton Exp $
+'\" RCS: @(#) $Id: open.n,v 1.4 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
.TH open n 7.6 Tcl "Tcl Built-In Commands"
@@ -217,9 +217,7 @@ no interactions between command pipelines and the console.
.TP
\fBMacintosh\fR
.
-Access to the serial port is not accomplished through magic cookies passed
-to the \fIopen\fR command on the Macintosh. Instead, you can use Sean Wood's
-(yoda@drexel.edu) \fIDevice\fR extension for the same purpose.
+Opening a serial port is not currently implemented under Macintosh.
.sp
Opening a command pipeline is not supported under Macintosh, since
applications do not support the concept of standard input or output.
diff --git a/doc/puts.n b/doc/puts.n
index 2042f9d..99e61a4 100644
--- a/doc/puts.n
+++ b/doc/puts.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: puts.n,v 1.2 1998/09/14 18:39:54 stanton Exp $
+'\" RCS: @(#) $Id: puts.n,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
.TH puts n 7.5 Tcl "Tcl Built-In Commands"
@@ -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/doc/read.n b/doc/read.n
index 77de6ce..21d9549 100644
--- a/doc/read.n
+++ b/doc/read.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: read.n,v 1.2 1998/09/14 18:39:54 stanton Exp $
+'\" RCS: @(#) $Id: read.n,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
.TH read n 7.5 Tcl "Tcl Built-In Commands"
@@ -40,8 +40,8 @@ before reaching the end of the file.
\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)
diff --git a/doc/regexp.n b/doc/regexp.n
index ed61c8d..0d08dcf 100644
--- a/doc/regexp.n
+++ b/doc/regexp.n
@@ -1,18 +1,18 @@
'\"
-'\" 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.
'\"
-'\" RCS: @(#) $Id: regexp.n,v 1.2 1998/09/14 18:39:54 stanton Exp $
+'\" RCS: @(#) $Id: regexp.n,v 1.3 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
-.TH regexp n "" Tcl "Tcl Built-In Commands"
+.TH regexp n 8.1 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
@@ -31,27 +31,61 @@ 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
+.TP 15
\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\-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
+.VS 8.1
+.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 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.
+.VE 8.1
+.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 +93,956 @@ 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 "DIFFERENT FLAVORS OF REs"
+.VS 8.1
+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 "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 "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 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 which has
+multi-character collating elements
+can thus match more than one character.
+Most insidiously, if
+\fB^\fR
+is used,
+this can happen even if no multi-character collating
+elements appear in the bracket expression!
+If the collating sequence includes a
+\fBch\fR
+multi-character collating element,
+then the RE
+\fB[[.ch.]]*c\fR
+matches the first five characters
+of
+`\fBchchcc\fR',
+and the RE
+\fB[^c]b\fR
+matches all of
+`\fBchb\fR'.
+.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.
+.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 class names are:
+.PP
+.RS
+.ne 5
+.nf
+.ta 3c 6c 9c
+\fBalnum digit punct
+alpha graph space
+blank lower upper
+cntrl print xdigit\fR
+.fi
+.RE
+.PP
+These stand for the character classes defined in
+\fIctype\fR(3).
+A locale may provide others.
+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
+which is neither preceded nor followed by
+word characters.
+A word character is an
+\fIalnum\fR
+character (as defined by
+\fIctype\fR(3))
+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, aka 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.
+.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 which 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, etc. (any character
+defined as \fIspace\fR by
+\fIctype\fR(3)).
+Exactly how a multi-line expanded-syntax RE
+can be entered interactively by a user,
+if at all, is application-specific;
+expanded syntax is primarily a scripting facility.
+.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.
+.VE 8.1
.SH KEYWORDS
match, regular expression, string
diff --git a/doc/registry.n b/doc/registry.n
index 4b7dbf3..f0e199f 100644
--- a/doc/registry.n
+++ b/doc/registry.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: registry.n,v 1.3 1999/02/02 22:25:21 stanton Exp $
+'\" RCS: @(#) $Id: registry.n,v 1.4 1999/04/16 00:46:35 stanton Exp $
'\"
.so man.macros
.TH registry n 8.0 Tcl "Tcl Built-In Commands"
@@ -112,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/doc/resource.n b/doc/resource.n
index 9858abc..428591b 100644
--- a/doc/resource.n
+++ b/doc/resource.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\" RCS: @(#) $Id: resource.n,v 1.3 1998/12/29 22:55:12 surles Exp $
+'\" RCS: @(#) $Id: resource.n,v 1.4 1999/04/16 00:46:36 stanton Exp $
'\"
.so man.macros
.TH resource n 8.0 Tcl "Tcl Built-In Commands"
@@ -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?
diff --git a/doc/safe.n b/doc/safe.n
index 6451823..749a57b 100644
--- a/doc/safe.n
+++ b/doc/safe.n
@@ -4,16 +4,15 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: safe.n,v 1.2 1998/09/14 18:39:55 stanton Exp $
+'\" RCS: @(#) $Id: safe.n,v 1.3 1999/04/16 00:46:36 stanton Exp $
'\"
.so man.macros
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
.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/doc/scan.n b/doc/scan.n
index 8d9b2ad..123ec5b 100644
--- a/doc/scan.n
+++ b/doc/scan.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: scan.n,v 1.2 1998/09/14 18:39:55 stanton Exp $
+'\" RCS: @(#) $Id: scan.n,v 1.3 1999/04/16 00:46:36 stanton Exp $
'\"
.so man.macros
.TH scan n "" Tcl "Tcl Built-In Commands"
@@ -31,25 +31,41 @@ and assigned to the corresponding variable.
.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.
+.VE 8.1
+.PP
The following conversion characters are supported:
.TP 10
\fBd\fR
@@ -63,6 +79,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 +119,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 +134,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 +161,11 @@ 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
+\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
diff --git a/doc/socket.n b/doc/socket.n
index ebb7383..d73883f 100644
--- a/doc/socket.n
+++ b/doc/socket.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: socket.n,v 1.3 1999/02/03 00:51:19 stanton Exp $
+'\" RCS: @(#) $Id: socket.n,v 1.4 1999/04/16 00:46:36 stanton Exp $
.so man.macros
.TH socket n 8.0 Tcl "Tcl Built-In Commands"
.BS
@@ -104,14 +104,14 @@ will be accepted.
.SH CONFIGURATION OPTIONS
The \fBfconfigure\fR command can be used to query several readonly
configuration options for socket channels:
-.VS
+.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
+.VE 8.0.5
.TP
\fB\-sockname\fR
This option returns a list of three elements, the address, the host name
diff --git a/doc/string.n b/doc/string.n
index 44ef20c..42d6e0b 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: string.n,v 1.2 1998/09/14 18:39:55 stanton Exp $
+'\" RCS: @(#) $Id: string.n,v 1.3 1999/04/16 00:46:36 stanton Exp $
'\"
.so man.macros
.TH string n 7.6 Tcl "Tcl Built-In Commands"
@@ -85,14 +85,22 @@ 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
.TP
\fBstring tolower \fIstring\fR
-Returns a value equal to \fIstring\fR except that all upper case
-letters have been converted to lower case.
+Returns a value equal to \fIstring\fR except that all upper (or title)
+case letters have been converted to lower case.
.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 totitle \fIstring\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.
+.TP
+\fBstring toupper \fIstring\fR
+Returns a value equal to \fIstring\fR except that all lower (or title)
+case letters have been converted to upper case.
+.VE
.TP
\fBstring trim \fIstring\fR ?\fIchars\fR?
Returns a value equal to \fIstring\fR except that any leading
@@ -114,18 +122,22 @@ 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
.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.
+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 (Unicode letters
+or decimal digits) or underscore (Unicode connector punctuation)
+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.
+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 (Unicode letters or decimal digits)
+or underscore (Unicode connector punctuation) characters, or any
+single character other than these.
+.VE
.SH KEYWORDS
case conversion, compare, index, match, pattern, string, word
diff --git a/doc/tclvars.n b/doc/tclvars.n
index 8536327..2e68519 100644
--- a/doc/tclvars.n
+++ b/doc/tclvars.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: tclvars.n,v 1.2 1998/09/14 18:39:55 stanton Exp $
+'\" RCS: @(#) $Id: tclvars.n,v 1.3 1999/04/16 00:46:36 stanton Exp $
'\"
.so man.macros
.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
@@ -259,16 +259,27 @@ 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
+\fBuser\fR
+Either \fBwindows\fR, \fBmacintosh\fR, or \fBunix\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
diff --git a/generic/regc_color.c b/generic/regc_color.c
new file mode 100644
index 0000000..e86fea0
--- /dev/null
+++ b/generic/regc_color.c
@@ -0,0 +1,742 @@
+/*
+ * colorings of characters
+ * This file is #included by regcomp.c.
+ *
+ * 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->max >= 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 (sco == COLORLESS) {
+ return 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)
+ 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 & BYTMASK) == 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);
+ */
+#if 0
+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;
+}
+#endif
+/*
+ - 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
+
+/*
+ - 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 /* ifdef REG_DEBUG */
diff --git a/generic/regc_cvec.c b/generic/regc_cvec.c
new file mode 100644
index 0000000..c79e741
--- /dev/null
+++ b/generic/regc_cvec.c
@@ -0,0 +1,170 @@
+/*
+ * Utility functions for handling cvecs
+ * This file is #included by regcomp.c.
+ */
+
+/*
+ - 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++;
+}
+
+#ifdef USE_MCCE
+/*
+ - 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 n = endp - startp;
+ int i;
+ chr *s;
+ chr *d;
+
+ assert(n > 0);
+ assert(cv->nchrs + n < cv->chrspace - cv->nmccechrs);
+ assert(cv->nmcces < cv->mccespace);
+ d = &cv->chrs[cv->chrspace - cv->nmccechrs - n - 1];
+ cv->mcces[cv->nmcces++] = d;
+ for (s = startp, i = n; i > 0; s++, i--)
+ *d++ = *s;
+ *d++ = 0; /* endmarker */
+ assert(d == &cv->chrs[cv->chrspace - cv->nmccechrs]);
+ cv->nmccechrs += n + 1;
+}
+#endif
+
+/*
+ - 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/generic/regc_lex.c b/generic/regc_lex.c
new file mode 100644
index 0000000..5b93e0b
--- /dev/null
+++ b/generic/regc_lex.c
@@ -0,0 +1,1010 @@
+/*
+ * lexical analyzer
+ * This file is #included by regcomp.c.
+ */
+
+/* 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;
+
+ /* 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');
+}
+
+/*
+ - 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/generic/regc_locale.c b/generic/regc_locale.c
new file mode 100644
index 0000000..82e83e2
--- /dev/null
+++ b/generic/regc_locale.c
@@ -0,0 +1,781 @@
+/*
+ * 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: regc_locale.c,v 1.2 1999/04/16 00:46:37 stanton Exp $
+ */
+
+/* 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;
+
+static crange alphaTable[] = {
+ {0X0041, 0X005A}, {0X0061, 0X007A}, {0X00AA, 0X00AA}, {0X00B5, 0X00B5},
+ {0X00BA, 0X00BA}, {0X00C0, 0X00D6}, {0X00D8, 0X00F6}, {0X00F8, 0X01F5},
+ {0X01FA, 0X0217}, {0X0250, 0X02A8}, {0X02B0, 0X02B8}, {0X02BB, 0X02C1},
+ {0X02E0, 0X02E4}, {0X037A, 0X037A}, {0x0386, 0x0386}, {0X0388, 0X038A},
+ {0X038C, 0X038C}, {0X038E, 0X03A1}, {0X03A3, 0X03CE}, {0X03D0, 0X03D6},
+ {0X03DA, 0X03DA}, {0X03DC, 0X03DC}, {0X03DE, 0X03DE}, {0X03E0, 0X03E0},
+ {0X03E2, 0X03F3}, {0X0401, 0X040C}, {0X040E, 0X044F}, {0X0451, 0X045C},
+ {0X045E, 0X0481}, {0X0490, 0X04C4}, {0X04C7, 0X04C8}, {0X04CB, 0X04CC},
+ {0X04D0, 0X04EB}, {0X04EE, 0X04F5}, {0X04F8, 0X04F9}, {0x0531, 0x0556},
+ {0x0559, 0x0559}, {0x0561, 0x0587}, {0X05D0, 0X05EA}, {0X05F0, 0X05F2},
+ {0X0621, 0X063A}, {0x0641, 0x0652}, {0X0670, 0X06B7}, {0X06BA, 0X06BE},
+ {0X06C0, 0X06CE}, {0X06D0, 0X06D3}, {0X06D5, 0X06DC}, {0X06E1, 0X06E8},
+ {0X06ED, 0X06ED}, {0x0901, 0x0903}, {0x0905, 0x0939}, {0X093D, 0X094C},
+ {0x0958, 0x0963}, {0x0981, 0x0983}, {0X0985, 0X098C}, {0X098F, 0X0990},
+ {0X0993, 0X09A8}, {0X09AA, 0X09B0}, {0X09B2, 0X09B2}, {0X09B6, 0X09B9},
+ {0X09BE, 0X09C4}, {0X09C7, 0X09C8}, {0X09CB, 0X09CC}, {0X09D7, 0X09D7},
+ {0X09DC, 0X09DD}, {0X09DF, 0X09E3}, {0X09F0, 0X09F1}, {0X0A02, 0X0A02},
+ {0X0A05, 0X0A0A}, {0X0A0F, 0X0A10}, {0X0A13, 0X0A28}, {0X0A2A, 0X0A30},
+ {0X0A32, 0X0A33}, {0X0A35, 0X0A36}, {0X0A38, 0X0A39}, {0X0A3E, 0X0A42},
+ {0X0A47, 0X0A48}, {0X0A4B, 0X0A4C}, {0X0A59, 0X0A5C}, {0X0A5E, 0X0A5E},
+ {0X0A70, 0X0A74}, {0X0A81, 0X0A83}, {0X0A85, 0X0A8B}, {0X0A8D, 0X0A8D},
+ {0X0A8F, 0X0A91}, {0X0A93, 0X0AA8}, {0X0AAA, 0X0AB0}, {0X0AB2, 0X0AB3},
+ {0X0AB5, 0X0AB9}, {0X0ABD, 0X0AC5}, {0X0AC7, 0X0AC9}, {0X0ACB, 0X0ACC},
+ {0X0AE0, 0X0AE0}, {0X0B01, 0X0B03}, {0X0B05, 0X0B0C}, {0X0B0F, 0X0B10},
+ {0X0B13, 0X0B28}, {0X0B2A, 0X0B30}, {0X0B32, 0X0B33}, {0X0B36, 0X0B39},
+ {0X0B3D, 0X0B43}, {0X0B47, 0X0B48}, {0X0B4B, 0X0B4C}, {0X0B56, 0X0B57},
+ {0X0B5C, 0X0B5D}, {0X0B5F, 0X0B61}, {0X0B82, 0X0B83}, {0X0B85, 0X0B8A},
+ {0X0B8E, 0X0B90}, {0X0B92, 0X0B95}, {0X0B99, 0X0B9A}, {0X0B9C, 0X0B9C},
+ {0X0B9E, 0X0B9F}, {0X0BA3, 0X0BA4}, {0X0BA8, 0X0BAA}, {0X0BAE, 0X0BB5},
+ {0X0BB7, 0X0BB9}, {0X0BBE, 0X0BC2}, {0X0BC6, 0X0BC8}, {0X0BCA, 0X0BCC},
+ {0X0BD7, 0X0BD7}, {0X0C01, 0X0C03}, {0X0C05, 0X0C0C}, {0X0C0E, 0X0C10},
+ {0X0C12, 0X0C28}, {0X0C2A, 0X0C33}, {0X0C35, 0X0C39}, {0X0C3E, 0X0C44},
+ {0X0C46, 0X0C48}, {0X0C4A, 0X0C4C}, {0X0C55, 0X0C56}, {0X0C60, 0X0C61},
+ {0X0C82, 0X0C83}, {0X0C85, 0X0C8C}, {0X0C8E, 0X0C90}, {0X0C92, 0X0CA8},
+ {0X0CAA, 0X0CB3}, {0X0CB5, 0X0CB9}, {0X0CBE, 0X0CC4}, {0X0CC6, 0X0CC8},
+ {0X0CCA, 0X0CCC}, {0X0CD5, 0X0CD6}, {0X0CDE, 0X0CDE}, {0X0CE0, 0X0CE1},
+ {0X0D02, 0X0D03}, {0X0D05, 0X0D0C}, {0X0D0E, 0X0D10}, {0X0D12, 0X0D28},
+ {0X0D2A, 0X0D39}, {0X0D3E, 0X0D43}, {0X0D46, 0X0D48}, {0X0D4A, 0X0D4C},
+ {0X0D57, 0X0D57}, {0X0D60, 0X0D61}, {0X0E01, 0X0E2E}, {0X0E30, 0X0E3A},
+ {0X0E40, 0X0E45}, {0X0E47, 0X0E47}, {0X0E4D, 0X0E4D}, {0X0E81, 0X0E82},
+ {0X0E84, 0X0E84}, {0X0E87, 0X0E88}, {0X0E8A, 0X0E8A}, {0X0E8D, 0X0E8D},
+ {0X0E94, 0X0E97}, {0X0E99, 0X0E9F}, {0X0EA1, 0X0EA3}, {0X0EA5, 0X0EA5},
+ {0X0EA7, 0X0EA7}, {0X0EAA, 0X0EAB}, {0X0EAD, 0X0EAE}, {0X0EB0, 0X0EB9},
+ {0X0EBB, 0X0EBD}, {0X0EC0, 0X0EC4}, {0X0ECD, 0X0ECD}, {0X0EDC, 0X0EDD},
+ {0X0F40, 0X0F47}, {0X0F49, 0X0F69}, {0X0F71, 0X0F81}, {0X0F90, 0X0F95},
+ {0X0F97, 0X0F97}, {0X0F99, 0X0FAD}, {0X0FB1, 0X0FB7}, {0X0FB9, 0X0FB9},
+ {0X10A0, 0X10C5}, {0X10D0, 0X10F6}, {0x1100, 0x1159}, {0X115F, 0X11A2},
+ {0X11A8, 0X11F9}, {0X1E00, 0X1E9B}, {0X1EA0, 0X1EF9}, {0X1F00, 0X1F15},
+ {0X1F18, 0X1F1D}, {0X1F20, 0X1F45}, {0X1F48, 0X1F4D}, {0X1F50, 0X1F57},
+ {0X1F59, 0X1F59}, {0X1F5B, 0X1F5B}, {0X1F5D, 0X1F5D}, {0X1F5F, 0X1F7D},
+ {0X1F80, 0X1FB4}, {0X1FB6, 0X1FBC}, {0X1FBE, 0X1FBE}, {0X1FC2, 0X1FC4},
+ {0X1FC6, 0X1FCC}, {0X1FD0, 0X1FD3}, {0X1FD6, 0X1FDB}, {0X1FE0, 0X1FEC},
+ {0X1FF2, 0X1FF4}, {0X1FF6, 0X1FFC}, {0X207F, 0X207F}, {0x2102, 0x2102},
+ {0x2107, 0x2107}, {0X210A, 0X2113}, {0x2115, 0x2115}, {0X2118, 0X211D},
+ {0x2124, 0x2124}, {0x2126, 0x2126}, {0x2128, 0x2128}, {0X212A, 0X2131},
+ {0x2133, 0x2138}, {0x2160, 0x2182}, {0x3041, 0x3094}, {0X30A1, 0X30FA},
+ {0X3105, 0X312C}, {0X3131, 0X318E}, {0XAC00, 0XD7A3}, {0XFB00, 0XFB06},
+ {0XFB13, 0XFB17}, {0XFB1F, 0XFB28}, {0XFB2A, 0XFB36}, {0XFB38, 0XFB3C},
+ {0XFB3E, 0XFB3E}, {0XFB40, 0XFB41}, {0XFB43, 0XFB44}, {0XFB46, 0XFBB1},
+ {0XFBD3, 0XFD3D}, {0XFD50, 0XFD8F}, {0XFD92, 0XFDC7}, {0XFDF0, 0XFDFB},
+ {0XFE70, 0XFE72}, {0XFE74, 0XFE74}, {0XFE76, 0XFEFC}, {0XFF21, 0XFF3A},
+ {0XFF41, 0XFF5A}, {0XFF66, 0XFF6F}, {0XFF71, 0XFF9D}, {0XFFA0, 0XFFBE},
+ {0XFFC2, 0XFFC7}, {0XFFCA, 0XFFCF}, {0XFFD2, 0XFFD7}, {0XFFDA, 0XFFDC}
+};
+
+#define NUM_ALPHA (sizeof(alphaTable)/sizeof(crange))
+
+static crange digitTable[] = {
+ {0x0030, 0x0039}
+};
+
+#define NUM_DIGIT (sizeof(digitTable)/sizeof(crange))
+
+static crange punctTable[] = {
+ {0x0021, 0x0023}, {0X0025, 0X002A}, {0X002C, 0X002F}, {0X003A, 0X003B},
+ {0X003F, 0X0040}, {0X005B, 0X005D}, {0X005F, 0X005F}, {0X007B, 0X007B},
+ {0X007D, 0X007D}, {0X00A1, 0X00A1}, {0X00AB, 0X00AB}, {0X00AD, 0X00AD},
+ {0X00BB, 0X00BB}, {0X00BF, 0X00BF}, {0X02BC, 0X02BC}, {0x0374, 0x0375},
+ {0X037E, 0X037E}, {0x0387, 0x0387}, {0X055A, 0X055F}, {0x0589, 0x0589},
+ {0X05BE, 0X05BE}, {0X05C0, 0X05C0}, {0X05C3, 0X05C3}, {0X05F3, 0X05F4},
+ {0X060C, 0X060C}, {0X061B, 0X061B}, {0X061F, 0X061F}, {0X066A, 0X066D},
+ {0X06D4, 0X06D4}, {0x0964, 0x0965}, {0x0970, 0x0970}, {0X0E2F, 0X0E2F},
+ {0X0E5A, 0X0E5B}, {0X0EAF, 0X0EAF}, {0X0F04, 0X0F12}, {0X0F3A, 0X0F3F},
+ {0X0F85, 0X0F85}, {0X10FB, 0X10FB}, {0x2010, 0x2027}, {0x2030, 0x2043},
+ {0x2045, 0x2046}, {0X207D, 0X207E}, {0X208D, 0X208E}, {0X2329, 0X232A},
+ {0x3001, 0x3003}, {0x3006, 0x3006}, {0x3008, 0x3011}, {0X3014, 0X301F},
+ {0x3030, 0x3030}, {0X30FB, 0X30FB}, {0XFD3E, 0XFD3F}, {0XFE30, 0XFE44},
+ {0XFE49, 0XFE52}, {0XFE54, 0XFE61}, {0XFE63, 0XFE63}, {0XFE68, 0XFE68},
+ {0XFE6A, 0XFE6B}, {0XFF01, 0XFF03}, {0XFF05, 0XFF0A}, {0XFF0C, 0XFF0F},
+ {0XFF1A, 0XFF1B}, {0XFF1F, 0XFF20}, {0XFF3B, 0XFF3D}, {0XFF3F, 0XFF3F},
+ {0XFF5B, 0XFF5B}, {0XFF5D, 0XFF5D}, {0XFF61, 0XFF65}
+};
+
+#define NUM_PUNCT (sizeof(punctTable)/sizeof(crange))
+
+static crange spaceTable[] = {
+ {0x0000, 0x0000}, {0x0009, 0x000D}, {0x0020, 0x0020}, {0x00A0, 0x00A0},
+ {0x2000, 0x200F}, {0x2028, 0x202E}, {0X206A, 0X206F}, {0x3000, 0x3000},
+ {0xFEFF, 0xFEFF}
+};
+
+#define NUM_SPACE (sizeof(spaceTable)/sizeof(crange))
+
+static crange upperRangeTable[] = {
+ {0x0041, 0x005a}, {0x00c0, 0x00d6}, {0x00d8, 0x00de}, {0x0189, 0x018b},
+ {0x018e, 0x0191}, {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}, {0x2118, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2131},
+ {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, 0x0196, 0x0197,
+ 0x0198, 0x019c, 0x019d, 0x019f, 0x01a0, 0x01a2, 0x01a4, 0x01a6, 0x01a7,
+ 0x01a9, 0x01ac, 0x01ae, 0x01af, 0x01b1, 0x01b2, 0x01b3, 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, 0x1fbe,
+ 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x2133
+};
+
+#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))
+
+static crange lowerRangeTable[] = {
+ {0x0061, 0x007a}, {0x00df, 0x00f6}, {0x00f8, 0x00ff}, {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},
+ {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, 0x0138, 0x013a, 0x013c, 0x013e, 0x0140, 0x0142,
+ 0x0144, 0x0146, 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, 0x017e, 0x017f, 0x0180, 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, 0x01dd, 0x01df,
+ 0x01e1, 0x01e3, 0x01e5, 0x01e7, 0x01e9, 0x01eb, 0x01ed, 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, 0x1fc2, 0x1fc3,
+ 0x1fc4, 0x1fc6, 0x1fc7, 0x1fd6, 0x1fd7, 0x1ff6, 0x1ff7, 0x207f, 0x210a,
+ 0x210e, 0x210f, 0x2113, 0x212e, 0x212f, 0x2134
+};
+
+#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))
+
+/*
+ * The graph table includes the set of characters that are neither ISO control
+ * characters nor in the space table.
+ */
+
+static crange graphTable[] = {
+ {0x0021, 0x007e}, {0x00a1, 0x1fff}, {0x2010, 0x2027}, {0x202f, 0x2069},
+ {0x2070, 0x2fff}, {0x3001, 0xfefe}, {0xff00, 0xffff}
+};
+
+#define NUM_GRAPH (sizeof(graphTable)/sizeof(crange))
+#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_FAKEEC) && 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", "blank", "cntrl", "digit", "graph", "lower",
+ "print", "punct", "space", "upper", "xdigit", NULL
+ };
+
+ enum classes {
+ CC_ALNUM, CC_ALPHA, 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, 0, NUM_DIGIT + NUM_ALPHA, 0);
+ if (cv) {
+ for (i = 0; i < NUM_ALPHA; i++) {
+ addrange(cv, alphaTable[i].start, alphaTable[i].end);
+ }
+ for (i = 0; i < NUM_DIGIT; i++) {
+ addrange(cv, digitTable[i].start, digitTable[i].end);
+ }
+ }
+ break;
+ case CC_ALPHA:
+ cv = getcvec(v, 0, NUM_ALPHA, 0);
+ if (cv) {
+ for (i = 0; i < NUM_ALPHA; i++) {
+ addrange(cv, alphaTable[i].start, alphaTable[i].end);
+ }
+ }
+ 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, 0);
+ if (cv) {
+ for (i = 0; i < NUM_DIGIT; i++) {
+ addrange(cv, digitTable[i].start, digitTable[i].end);
+ }
+ }
+ break;
+ case CC_PUNCT:
+ cv = getcvec(v, 0, NUM_PUNCT, 0);
+ if (cv) {
+ for (i = 0; i < NUM_PUNCT; i++) {
+ addrange(cv, punctTable[i].start, punctTable[i].end);
+ }
+ }
+ break;
+ case CC_XDIGIT:
+ cv = getcvec(v, 0, NUM_DIGIT+2, 0);
+ if (cv) {
+ for (i = 0; i < NUM_DIGIT; i++) {
+ addrange(cv, digitTable[i].start, digitTable[i].end);
+ }
+ addrange(cv, 'a', 'f');
+ addrange(cv, 'A', 'F');
+ }
+ break;
+ case CC_SPACE:
+ cv = getcvec(v, 0, NUM_SPACE, 0);
+ if (cv) {
+ for (i = 0; i < NUM_SPACE; i++) {
+ addrange(cv, spaceTable[i].start, spaceTable[i].end);
+ }
+ }
+ 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, 0, NUM_GRAPH, 0);
+ if (cv) {
+ for (i = 0; i < NUM_GRAPH; i++) {
+ addrange(cv, graphTable[i].start, graphTable[i].end);
+ }
+ }
+ 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/generic/regc_nfa.c b/generic/regc_nfa.c
new file mode 100644
index 0000000..80e9ac7
--- /dev/null
+++ b/generic/regc_nfa.c
@@ -0,0 +1,1528 @@
+/*
+ * NFA utilities.
+ * This file is #included by regcomp.c.
+ *
+ * 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);
+}
+
+/*
+ - newfstate - allocate an NFA state, with 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;
+ int i;
+
+ 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 = &s->oas.a[0];
+ for (i = 0; i < ABSIZE; i++) {
+ s->oas.a[i].type = 0;
+ s->oas.a[i].freechain = &s->oas.a[i+1];
+ }
+ s->oas.a[ABSIZE-1].freechain = NULL;
+ }
+
+ assert(nfa->nstates >= 0);
+ s->no = nfa->nstates++;
+ s->flag = (char)flag;
+ 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;
+}
+
+/*
+ - newstate - allocate an ordinary NFA state
+ ^ static struct state *newstate(struct nfa *);
+ */
+static struct state * /* NULL on error */
+newstate(nfa)
+struct nfa *nfa;
+{
+ return newfstate(nfa, 0);
+}
+
+/*
+ - 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->type == t && a->co == co && a->to == to)
+ 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;
+
+ /* 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 int optimize(struct nfa *, FILE *);
+ */
+static int /* 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 int analyze(struct nfa *);
+ */
+static int /* 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 */
+
+/*
+ - 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 /* 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 */
+
+/*
+ - 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 /* ifdef REG_DEBUG */
diff --git a/generic/regcomp.c b/generic/regcomp.c
new file mode 100644
index 0000000..8e1b61c
--- /dev/null
+++ b/generic/regcomp.c
@@ -0,0 +1,2124 @@
+/*
+ * re_*comp and friends - compile REs
+ * This file #includes several others (see the bottom).
+ */
+
+#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 makescan _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 int nfatree _ANSI_ARGS_((struct vars *, struct subre *, FILE *));
+static int 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, int));
+/* === 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));
+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 *));
+#if 0
+static int singleton _ANSI_ARGS_((struct colormap *, pchr c));
+#endif
+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 *newfstate _ANSI_ARGS_((struct nfa *, int flag));
+static struct state *newstate _ANSI_ARGS_((struct nfa *));
+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 int 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 int 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));
+#ifdef USE_MCCE
+static VOID addmcce _ANSI_ARGS_((struct cvec *, chr *, chr *));
+#endif
+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 */
+ int usedshorter; /* used short-preferring quantifiers */
+ int unmatchable; /* can never match */
+};
+
+/* 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);
+ }
+ 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) {
+ dumpnfa(v->nfa, debug);
+ dumpst(v->tree, debug, 1);
+ }
+ v->usedshorter = 0;
+ v->unmatchable = 0;
+ optst(v, v->tree);
+ v->ntree = numst(v->tree, 1);
+ markst(v->tree);
+ cleanst(v);
+ if (debug != NULL) {
+ fprintf(debug, "-->\n");
+ dumpst(v->tree, debug, 1);
+ }
+
+ /* build compacted NFAs for tree, lacons, fast search */
+ re->re_info |= nfatree(v, v->tree, debug);
+ if (debug != NULL) {
+ fprintf(debug, "---->\n");
+ dumpst(v->tree, debug, 1);
+ }
+ CNOERR();
+ if (re->re_info&REG_UIMPOSSIBLE)
+ v->unmatchable = 1;
+ assert(v->nlacons == 0 || v->lacons != NULL);
+ for (i = 1; i < v->nlacons; i++)
+ nfanode(v, &v->lacons[i], debug);
+ CNOERR();
+ (DISCARD)optimize(v->nfa, debug);
+ CNOERR();
+ makescan(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;
+ g->usedshorter = v->usedshorter;
+ g->unmatchable = v->unmatchable;
+
+ 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;
+}
+
+/*
+ - makescan - turn an NFA into a fast-scan NFA (implicit prepend of .*?)
+ * NFA must have been optimize()d already.
+ ^ static VOID makescan(struct vars *, struct nfa *);
+ */
+static VOID
+makescan(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 \Z* 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));
+ 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;
+
+ /* preference cleanup and analysis */
+ if (t->flags&SHORTER)
+ v->usedshorter = 1;
+
+ /* 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 int nfatree(struct vars *, struct subre *, FILE *);
+ */
+static int /* 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 int nfanode(struct vars *, struct subre *, FILE *);
+ */
+static int /* optimize results */
+nfanode(v, t, f)
+struct vars *v;
+struct subre *t;
+FILE *f; /* for debug output */
+{
+ struct nfa *nfa;
+ int ret = 0;
+
+ assert(t->begin != NULL);
+
+ 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, "nsub %d, info 0%o, csize %d, ntree %d, usedshort %d\n",
+ re->re_nsub, re->re_info, re->re_csize, g->ntree,
+ g->usedshorter);
+
+ dumpcolors(&g->cmap, f);
+ if (!NULLCNFA(g->search)) {
+ printf("search:\n");
+ dumpcnfa(&g->search, f);
+ }
+ for (i = 1; i < g->nlacons; i++) {
+ fprintf(f, "la%d (%s):\n", i,
+ (g->lacons[i].subno) ? "positive" : "negative");
+ dumpcnfa(&g->lacons[i].cnfa, f);
+ }
+ 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, 0);
+ fflush(f);
+}
+
+/*
+ - stdump - recursive guts of dumpst
+ ^ static VOID stdump(struct subre *, FILE *, int, int);
+ */
+static VOID
+stdump(t, f, nfapresent, level)
+struct subre *t;
+FILE *f;
+int nfapresent; /* is the original NFA still around? */
+int level;
+{
+ int i;
+# define RTSEP " "
+
+ for (i = 0; i < level; i++)
+ fprintf(f, RTSEP);
+ fprintf(f, "%c (", t->op);
+ if (t->flags&LONGER)
+ fprintf(f, "L");
+ if (t->flags&SHORTER)
+ fprintf(f, "S");
+ if (t->flags&MIXED)
+ fprintf(f, "M");
+ if (t->flags&CAP)
+ fprintf(f, "c");
+ if (t->flags&BACKR)
+ fprintf(f, "b");
+ if (!(t->flags&INUSE))
+ fprintf(f, "!u");
+ fprintf(f, ") r%d", t->retry);
+ 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 (!NULLCNFA(t->cnfa))
+ fprintf(f, ":");
+ fprintf(f, "\n");
+ if (t->left != NULL)
+ stdump(t->left, f, nfapresent, level+1);
+ if (!NULLCNFA(t->cnfa))
+ dumpcnfa(&t->cnfa, f);
+ if (t->right != NULL)
+ stdump(t->right, f, nfapresent, level+1);
+}
+
+#include "regc_lex.c"
+#include "regc_color.c"
+#include "regc_nfa.c"
+#include "regc_cvec.c"
+#include "regc_locale.c"
diff --git a/generic/regcustom.h b/generic/regcustom.h
new file mode 100644
index 0000000..b1d53a9
--- /dev/null
+++ b/generic/regcustom.h
@@ -0,0 +1,85 @@
+/* headers (which also pick up the standard ones, or equivalents) */
+#include "tclInt.h"
+
+/* overrides for regguts.h definitions */
+/* function-pointer declarations */
+#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
+/* 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
+#ifndef __REG_NOFRONT
+#define __REG_NOFRONT /* don't want regcomp() and regexec() */
+#endif
+#ifndef __REG_NOCHAR
+#define __REG_NOCHAR /* or the char versions */
+#endif
+#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) */
+#ifdef notdef
+#define REG_DEBUG /* */
+#endif
+
+/* and pick up the standard header */
+#include "regex.h"
diff --git a/generic/rege_dfa.c b/generic/rege_dfa.c
new file mode 100644
index 0000000..eb31ffc6
--- /dev/null
+++ b/generic/rege_dfa.c
@@ -0,0 +1,627 @@
+/*
+ * DFA routines
+ * This file is #included by regexec.c.
+ */
+
+/*
+ - longest - longest-preferred matching engine
+ ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *);
+ */
+static chr * /* endpoint, or NULL */
+longest(v, d, start, stop)
+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 */
+{
+ 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;
+
+ /* 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) {
+ 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 = 0; i < d->nssused; 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 **);
+ */
+static chr * /* endpoint, or NULL */
+shortest(v, d, start, min, max, coldp)
+struct vars *v; /* used only for debug and exec flags */
+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 */
+{
+ 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;
+ chr *nopr;
+ int i;
+
+ /* initialize */
+ css = initialize(v, d, start);
+ cp = start;
+
+ /* 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;
+ else if (ss->flags&POSTSTATE) {
+ 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))
+ return NULL;
+
+ /* find last no-progress state set, if any */
+ nopr = d->lastnopr;
+ for (ss = d->ssets, i = 0; i < d->nssused; ss++, i++)
+ if ((ss->flags&NOPROGRESS) && nopr != ss->lastseen &&
+ (nopr == NULL || nopr < ss->lastseen))
+ nopr = ss->lastseen;
+ assert(nopr != NULL);
+ if (coldp != NULL)
+ *coldp = (nopr == v->start) ? nopr : nopr-1;
+ return cp;
+}
+
+/*
+ - 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 didlacons;
+
+ /* 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;
+ didlacons = 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 &&
+ !ISBSET(d->work, ca->to) &&
+ lacon(v, cnfa, cp,
+ ca->co)) {
+ BSET(d->work, ca->to);
+ dolacons = 1;
+ didlacons = 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)) {
+#ifndef xxx
+p->hash == h &&
+memcmp(VS(d->work), VS(p->states),
+ d->wordsper*sizeof(unsigned)) == 0) {
+#endif
+ 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 (!didlacons) { /* lookahead conds. always cache miss */
+ 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);
+ 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/generic/regerror.c b/generic/regerror.c
new file mode 100644
index 0000000..6779e51
--- /dev/null
+++ b/generic/regerror.c
@@ -0,0 +1,82 @@
+/*
+ * regerror - error-code expansion
+ */
+
+#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/generic/regerrs.h b/generic/regerrs.h
new file mode 100644
index 0000000..1b6552c
--- /dev/null
+++ b/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.2)" },
+{ 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/generic/regex.h b/generic/regex.h
new file mode 100644
index 0000000..2f3ebfa
--- /dev/null
+++ b/generic/regex.h
@@ -0,0 +1,308 @@
+#ifndef _REGEX_H_
+#define _REGEX_H_ /* never again */
+/*
+ * regular expressions
+ *
+ * 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
+/* 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
+#ifndef __REG_NOFRONT
+#define __REG_NOFRONT /* don't want regcomp() and regexec() */
+#endif
+#ifndef __REG_NOCHAR
+#define __REG_NOCHAR /* or the char versions */
+#endif
+#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 */
+ int 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
+ 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 (placeholder for later work) */
+typedef struct {
+ int rm_dummy;
+} 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_DUMP 004000 /* none of your business :-) */
+#define REG_FAKEEC 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/generic/regexec.c b/generic/regexec.c
new file mode 100644
index 0000000..088d12b
--- /dev/null
+++ b/generic/regexec.c
@@ -0,0 +1,952 @@
+/*
+ * re_*exec and friends - match REs
+ */
+
+#include "regguts.h"
+
+
+
+/* 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;
+ 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 */
+};
+#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;} /* if error seen, return */
+#define OFF(p) ((p) - v->start)
+#define LOFF(p) ((long)OFF(p))
+
+
+
+/* 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];
+};
+
+
+
+
+/*
+ * 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 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 *));
+static chr *shortest _ANSI_ARGS_((struct vars *, struct dfa *, chr *, chr *, chr *, chr **));
+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; /* hook for future elaboration */
+size_t nmatch;
+regmatch_t pmatch[];
+int flags;
+{
+ struct vars var;
+ register struct vars *v = &var;
+ int st;
+ size_t n;
+ int complications;
+# 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->unmatchable)
+ return REG_NOMATCH;
+ complications = (v->g->info&REG_UBACKREF) ? 1 : 0;
+ if (v->g->usedshorter)
+ complications = 1;
+ v->eflags = flags;
+ if (v->g->cflags&REG_NOSUB)
+ nmatch = 0; /* override client */
+ v->nmatch = nmatch;
+ if (complications && v->nmatch < v->g->nsub + 1) {
+ /* need work area bigger than what user gave us */
+ 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->start = (chr *)string;
+ v->stop = (chr *)string + len;
+ v->err = 0;
+ if (complications) {
+ 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 (complications)
+ 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 smalldfa da;
+ struct dfa *d = newdfa(v, cnfa, cm, &da);
+ struct smalldfa sa;
+ struct dfa *s = newdfa(v, &v->g->search, cm, &sa);
+ chr *begin;
+ chr *end;
+ chr *open; /* open and close of range of possible starts */
+ chr *close;
+
+ if (d == NULL)
+ return v->err;
+ if (s == NULL) {
+ freedfa(d);
+ return v->err;
+ }
+
+ close = v->start;
+ do {
+ MDEBUG(("\nsearch at %ld\n", LOFF(close)));
+ close = shortest(v, s, close, close, v->stop, &open);
+ if (close == NULL)
+ break; /* NOTE BREAK */
+ if (v->nmatch == 0) {
+ /* don't need exact location */
+ freedfa(d);
+ freedfa(s);
+ return REG_OKAY;
+ }
+ MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
+ for (begin = open; begin <= close; begin++) {
+ MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
+ end = longest(v, d, begin, v->stop);
+ if (end != NULL) {
+ assert(v->nmatch > 0);
+ v->pmatch[0].rm_so = OFF(begin);
+ v->pmatch[0].rm_eo = OFF(end);
+ freedfa(d);
+ freedfa(s);
+ if (v->nmatch > 1) {
+ zapsubs(v->pmatch, v->nmatch);
+ return dissect(v, v->g->tree, begin,
+ end);
+ }
+ if (ISERR())
+ return v->err;
+ return REG_OKAY;
+ }
+ }
+ } while (close < v->stop);
+
+ freedfa(d);
+ freedfa(s);
+ if (ISERR())
+ return v->err;
+ return REG_NOMATCH;
+}
+
+/*
+ - 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 smalldfa da;
+ struct dfa *d = newdfa(v, cnfa, cm, &da);
+ struct smalldfa sa;
+ struct dfa *s = newdfa(v, &v->g->search, cm, &sa);
+ chr *begin;
+ chr *end;
+ 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;
+
+ if (d == NULL)
+ return v->err;
+ if (s == NULL) {
+ freedfa(d);
+ return v->err;
+ }
+
+ close = v->start;
+ do {
+ MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
+ close = shortest(v, s, close, close, v->stop, &open);
+ if (close == NULL)
+ break; /* NOTE BREAK */
+ 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);
+ else
+ end = longest(v, d, begin, estop);
+ 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);
+ switch (er) {
+ case REG_OKAY:
+ if (v->nmatch > 0) {
+ v->pmatch[0].rm_so = OFF(begin);
+ v->pmatch[0].rm_eo = OFF(end);
+ }
+ freedfa(d);
+ freedfa(s);
+ if (ISERR())
+ return v->err;
+ return REG_OKAY;
+ break;
+ case REG_NOMATCH:
+ /* go around and try again */
+ if ((shorter) ? end == estop :
+ end == begin) {
+ /* no point in trying again */
+ freedfa(s);
+ freedfa(d);
+ return REG_NOMATCH;
+ }
+ if (shorter)
+ estart = end + 1;
+ else
+ estop = end - 1;
+ break;
+ default:
+ freedfa(d);
+ freedfa(s);
+ return er;
+ break;
+ }
+ }
+ }
+ } while (close < v->stop);
+
+ freedfa(d);
+ freedfa(s);
+ if (ISERR())
+ return v->err;
+ 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 smalldfa da;
+ struct dfa *d;
+ struct smalldfa d2a;
+ struct dfa *d2;
+ chr *mid;
+ int i;
+
+ 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, &da);
+ if (ISERR())
+ return v->err;
+ d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &d2a);
+ if (ISERR()) {
+ freedfa(d);
+ return v->err;
+ }
+
+ /* pick a tentative midpoint */
+ mid = longest(v, d, begin, end);
+ 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) != end) {
+ /* that midpoint didn't work, find a new one */
+ if (mid == begin) {
+ /* all possibilities exhausted! */
+ MDEBUG(("no midpoint!\n"));
+ freedfa(d);
+ freedfa(d2);
+ return REG_ASSERT;
+ }
+ mid = longest(v, d, begin, mid-1);
+ 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 smalldfa da;
+ 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, &da);
+ if (ISERR())
+ return v->err;
+ if (longest(v, d, begin, end) == 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\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 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 smalldfa da;
+ struct dfa *d;
+ struct smalldfa d2a;
+ 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, &da);
+ if (ISERR())
+ return v->err;
+ d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &d2a);
+ 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);
+ 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) == 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);
+ 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 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 smalldfa da;
+ struct dfa *d;
+ struct smalldfa d2a;
+ 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, &da);
+ if (ISERR())
+ return v->err;
+ d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &d2a);
+ 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);
+ 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) == 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);
+ 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 smalldfa da;
+ 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, &da);
+ if (ISERR())
+ return v->err;
+ if (longest(v, d, begin, end) != 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/generic/regexp.c b/generic/regexp.c
deleted file mode 100644
index 8d95c45..0000000
--- a/generic/regexp.c
+++ /dev/null
@@ -1,1333 +0,0 @@
-/*
- * TclRegComp and TclRegExec -- TclRegSub is elsewhere
- *
- * Copyright (c) 1986 by University of Toronto.
- * Written by Henry Spencer. Not derived from licensed software.
- *
- * Permission is granted to anyone to use this software for any
- * purpose on any computer system, and to redistribute it freely,
- * subject to the following restrictions:
- *
- * 1. The author is not responsible for the consequences of use of
- * this software, no matter how awful, even if they arise
- * from defects in it.
- *
- * 2. The origin of this software must not be misrepresented, either
- * by explicit claim or by omission.
- *
- * 3. Altered versions must be plainly marked as such, and must not
- * be misrepresented as being the original software.
- *
- * Beware that some of this code is subtly aware of the way operator
- * precedence is structured in regular expressions. Serious changes in
- * regular-expression syntax might require a total rethink.
- *
- * *** NOTE: this code has been altered slightly for use in Tcl: ***
- * *** 1. Use ckalloc and ckfree instead of malloc and free. ***
- * *** 2. Add extra argument to regexp to specify the real ***
- * *** start of the string separately from the start of the ***
- * *** current search. This is needed to search for multiple ***
- * *** matches within a string. ***
- * *** 3. Names have been changed, e.g. from regcomp to ***
- * *** TclRegComp, to avoid clashes with other ***
- * *** regexp implementations used by applications. ***
- * *** 4. Added errMsg declaration and TclRegError procedure ***
- * *** 5. Various lint-like things, such as casting arguments ***
- * *** in procedure calls. ***
- *
- * *** NOTE: This code has been altered for use in MT-Sturdy Tcl ***
- * *** 1. All use of static variables has been changed to access ***
- * *** fields of a structure. ***
- * *** 2. This in addition to changes to TclRegError makes the ***
- * *** code multi-thread safe. ***
- *
- * RCS: @(#) $Id: regexp.c,v 1.2 1998/09/14 18:39:57 stanton Exp $
- */
-
-#include "tclInt.h"
-#include "tclPort.h"
-
-/*
- * The variable below is set to NULL before invoking regexp functions
- * and checked after those functions. If an error occurred then TclRegError
- * will set the variable to point to a (static) error message. This
- * mechanism unfortunately does not support multi-threading, but the
- * procedures TclRegError and TclGetRegError can be modified to use
- * thread-specific storage for the variable and thereby make the code
- * thread-safe.
- */
-
-static char *errMsg = NULL;
-
-/*
- * The "internal use only" fields in regexp.h are present to pass info from
- * compile to execute that permits the execute phase to run lots faster on
- * simple cases. They are:
- *
- * regstart char that must begin a match; '\0' if none obvious
- * reganch is the match anchored (at beginning-of-line only)?
- * regmust string (pointer into program) that match must include, or NULL
- * regmlen length of regmust string
- *
- * Regstart and reganch permit very fast decisions on suitable starting points
- * for a match, cutting down the work a lot. Regmust permits fast rejection
- * of lines that cannot possibly match. The regmust tests are costly enough
- * that TclRegComp() supplies a regmust only if the r.e. contains something
- * potentially expensive (at present, the only such thing detected is * or +
- * at the start of the r.e., which can involve a lot of backup). Regmlen is
- * supplied because the test in TclRegExec() needs it and TclRegComp() is
- * computing it anyway.
- */
-
-/*
- * Structure for regexp "program". This is essentially a linear encoding
- * of a nondeterministic finite-state machine (aka syntax charts or
- * "railroad normal form" in parsing technology). Each node is an opcode
- * plus a "next" pointer, possibly plus an operand. "Next" pointers of
- * all nodes except BRANCH implement concatenation; a "next" pointer with
- * a BRANCH on both ends of it is connecting two alternatives. (Here we
- * have one of the subtle syntax dependencies: an individual BRANCH (as
- * opposed to a collection of them) is never concatenated with anything
- * because of operator precedence.) The operand of some types of node is
- * a literal string; for others, it is a node leading into a sub-FSM. In
- * particular, the operand of a BRANCH node is the first node of the branch.
- * (NB this is *not* a tree structure: the tail of the branch connects
- * to the thing following the set of BRANCHes.) The opcodes are:
- */
-
-/* definition number opnd? meaning */
-#define END 0 /* no End of program. */
-#define BOL 1 /* no Match "" at beginning of line. */
-#define EOL 2 /* no Match "" at end of line. */
-#define ANY 3 /* no Match any one character. */
-#define ANYOF 4 /* str Match any character in this string. */
-#define ANYBUT 5 /* str Match any character not in this string. */
-#define BRANCH 6 /* node Match this alternative, or the next... */
-#define BACK 7 /* no Match "", "next" ptr points backward. */
-#define EXACTLY 8 /* str Match this string. */
-#define NOTHING 9 /* no Match empty string. */
-#define STAR 10 /* node Match this (simple) thing 0 or more times. */
-#define PLUS 11 /* node Match this (simple) thing 1 or more times. */
-#define OPEN 20 /* no Mark this point in input as start of #n. */
- /* OPEN+1 is number 1, etc. */
-#define CLOSE (OPEN+NSUBEXP) /* no Analogous to OPEN. */
-
-/*
- * Opcode notes:
- *
- * BRANCH The set of branches constituting a single choice are hooked
- * together with their "next" pointers, since precedence prevents
- * anything being concatenated to any individual branch. The
- * "next" pointer of the last BRANCH in a choice points to the
- * thing following the whole choice. This is also where the
- * final "next" pointer of each individual branch points; each
- * branch starts with the operand node of a BRANCH node.
- *
- * BACK Normal "next" pointers all implicitly point forward; BACK
- * exists to make loop structures possible.
- *
- * STAR,PLUS '?', and complex '*' and '+', are implemented as circular
- * BRANCH structures using BACK. Simple cases (one character
- * per match) are implemented with STAR and PLUS for speed
- * and to minimize recursive plunges.
- *
- * OPEN,CLOSE ...are numbered at compile time.
- */
-
-/*
- * A node is one char of opcode followed by two chars of "next" pointer.
- * "Next" pointers are stored as two 8-bit pieces, high order first. The
- * value is a positive offset from the opcode of the node containing it.
- * An operand, if any, simply follows the node. (Note that much of the
- * code generation knows about this implicit relationship.)
- *
- * Using two bytes for the "next" pointer is vast overkill for most things,
- * but allows patterns to get big without disasters.
- */
-#define OP(p) (*(p))
-#define NEXT(p) (((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
-#define OPERAND(p) ((p) + 3)
-
-/*
- * See regmagic.h for one further detail of program structure.
- */
-
-
-/*
- * Utility definitions.
- */
-#ifndef CHARBITS
-#define UCHARAT(p) ((int)*(unsigned char *)(p))
-#else
-#define UCHARAT(p) ((int)*(p)&CHARBITS)
-#endif
-
-#define FAIL(m) { TclRegError(m); return(NULL); }
-#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?')
-#define META "^$.[()|?+*\\"
-
-/*
- * Flags to be passed up and down.
- */
-#define HASWIDTH 01 /* Known never to match null string. */
-#define SIMPLE 02 /* Simple enough to be STAR/PLUS operand. */
-#define SPSTART 04 /* Starts with * or +. */
-#define WORST 0 /* Worst case. */
-
-/*
- * Global work variables for TclRegComp().
- */
-struct regcomp_state {
- char *regparse; /* Input-scan pointer. */
- int regnpar; /* () count. */
- char *regcode; /* Code-emit pointer; &regdummy = don't. */
- long regsize; /* Code size. */
-};
-
-static char regdummy;
-
-/*
- * The first byte of the regexp internal "program" is actually this magic
- * number; the start node begins in the second byte.
- */
-#define MAGIC 0234
-
-
-/*
- * Forward declarations for TclRegComp()'s friends.
- */
-
-static char * reg _ANSI_ARGS_((int paren, int *flagp,
- struct regcomp_state *rcstate));
-static char * regatom _ANSI_ARGS_((int *flagp,
- struct regcomp_state *rcstate));
-static char * regbranch _ANSI_ARGS_((int *flagp,
- struct regcomp_state *rcstate));
-static void regc _ANSI_ARGS_((int b,
- struct regcomp_state *rcstate));
-static void reginsert _ANSI_ARGS_((int op, char *opnd,
- struct regcomp_state *rcstate));
-static char * regnext _ANSI_ARGS_((char *p));
-static char * regnode _ANSI_ARGS_((int op,
- struct regcomp_state *rcstate));
-static void regoptail _ANSI_ARGS_((char *p, char *val));
-static char * regpiece _ANSI_ARGS_((int *flagp,
- struct regcomp_state *rcstate));
-static void regtail _ANSI_ARGS_((char *p, char *val));
-
-#ifdef STRCSPN
-static int strcspn _ANSI_ARGS_((char *s1, char *s2));
-#endif
-
-/*
- - TclRegComp - compile a regular expression into internal code
- *
- * We can't allocate space until we know how big the compiled form will be,
- * but we can't compile it (and thus know how big it is) until we've got a
- * place to put the code. So we cheat: we compile it twice, once with code
- * generation turned off and size counting turned on, and once "for real".
- * This also means that we don't allocate space until we are sure that the
- * thing really will compile successfully, and we never have to move the
- * code and thus invalidate pointers into it. (Note that it has to be in
- * one piece because free() must be able to free it all.)
- *
- * Beware that the optimization-preparation code in here knows about some
- * of the structure of the compiled regexp.
- */
-regexp *
-TclRegComp(exp)
-char *exp;
-{
- register regexp *r;
- register char *scan;
- register char *longest;
- register int len;
- int flags;
- struct regcomp_state state;
- struct regcomp_state *rcstate= &state;
-
- if (exp == NULL)
- FAIL("NULL argument");
-
- /* First pass: determine size, legality. */
- rcstate->regparse = exp;
- rcstate->regnpar = 1;
- rcstate->regsize = 0L;
- rcstate->regcode = &regdummy;
- regc(MAGIC, rcstate);
- if (reg(0, &flags, rcstate) == NULL)
- return(NULL);
-
- /* Small enough for pointer-storage convention? */
- if (rcstate->regsize >= 32767L) /* Probably could be 65535L. */
- FAIL("regexp too big");
-
- /* Allocate space. */
- r = (regexp *)ckalloc(sizeof(regexp) + (unsigned)rcstate->regsize);
- if (r == NULL)
- FAIL("out of space");
-
- /* Second pass: emit code. */
- rcstate->regparse = exp;
- rcstate->regnpar = 1;
- rcstate->regcode = r->program;
- regc(MAGIC, rcstate);
- if (reg(0, &flags, rcstate) == NULL)
- return(NULL);
-
- /* Dig out information for optimizations. */
- r->regstart = '\0'; /* Worst-case defaults. */
- r->reganch = 0;
- r->regmust = NULL;
- r->regmlen = 0;
- scan = r->program+1; /* First BRANCH. */
- if (OP(regnext(scan)) == END) { /* Only one top-level choice. */
- scan = OPERAND(scan);
-
- /* Starting-point info. */
- if (OP(scan) == EXACTLY)
- r->regstart = *OPERAND(scan);
- else if (OP(scan) == BOL)
- r->reganch++;
-
- /*
- * If there's something expensive in the r.e., find the
- * longest literal string that must appear and make it the
- * regmust. Resolve ties in favor of later strings, since
- * the regstart check works with the beginning of the r.e.
- * and avoiding duplication strengthens checking. Not a
- * strong reason, but sufficient in the absence of others.
- */
- if (flags&SPSTART) {
- longest = NULL;
- len = 0;
- for (; scan != NULL; scan = regnext(scan))
- if (OP(scan) == EXACTLY && ((int) strlen(OPERAND(scan))) >= len) {
- longest = OPERAND(scan);
- len = strlen(OPERAND(scan));
- }
- r->regmust = longest;
- r->regmlen = len;
- }
- }
-
- return(r);
-}
-
-/*
- - reg - regular expression, i.e. main body or parenthesized thing
- *
- * Caller must absorb opening parenthesis.
- *
- * Combining parenthesis handling with the base level of regular expression
- * is a trifle forced, but the need to tie the tails of the branches to what
- * follows makes it hard to avoid.
- */
-static char *
-reg(paren, flagp, rcstate)
-int paren; /* Parenthesized? */
-int *flagp;
-struct regcomp_state *rcstate;
-{
- register char *ret;
- register char *br;
- register char *ender;
- register int parno = 0;
- int flags;
-
- *flagp = HASWIDTH; /* Tentatively. */
-
- /* Make an OPEN node, if parenthesized. */
- if (paren) {
- if (rcstate->regnpar >= NSUBEXP)
- FAIL("too many ()");
- parno = rcstate->regnpar;
- rcstate->regnpar++;
- ret = regnode(OPEN+parno,rcstate);
- } else
- ret = NULL;
-
- /* Pick up the branches, linking them together. */
- br = regbranch(&flags,rcstate);
- if (br == NULL)
- return(NULL);
- if (ret != NULL)
- regtail(ret, br); /* OPEN -> first. */
- else
- ret = br;
- if (!(flags&HASWIDTH))
- *flagp &= ~HASWIDTH;
- *flagp |= flags&SPSTART;
- while (*rcstate->regparse == '|') {
- rcstate->regparse++;
- br = regbranch(&flags,rcstate);
- if (br == NULL)
- return(NULL);
- regtail(ret, br); /* BRANCH -> BRANCH. */
- if (!(flags&HASWIDTH))
- *flagp &= ~HASWIDTH;
- *flagp |= flags&SPSTART;
- }
-
- /* Make a closing node, and hook it on the end. */
- ender = regnode((paren) ? CLOSE+parno : END,rcstate);
- regtail(ret, ender);
-
- /* Hook the tails of the branches to the closing node. */
- for (br = ret; br != NULL; br = regnext(br))
- regoptail(br, ender);
-
- /* Check for proper termination. */
- if (paren && *rcstate->regparse++ != ')') {
- FAIL("unmatched ()");
- } else if (!paren && *rcstate->regparse != '\0') {
- if (*rcstate->regparse == ')') {
- FAIL("unmatched ()");
- } else
- FAIL("junk on end"); /* "Can't happen". */
- /* NOTREACHED */
- }
-
- return(ret);
-}
-
-/*
- - regbranch - one alternative of an | operator
- *
- * Implements the concatenation operator.
- */
-static char *
-regbranch(flagp, rcstate)
-int *flagp;
-struct regcomp_state *rcstate;
-{
- register char *ret;
- register char *chain;
- register char *latest;
- int flags;
-
- *flagp = WORST; /* Tentatively. */
-
- ret = regnode(BRANCH,rcstate);
- chain = NULL;
- while (*rcstate->regparse != '\0' && *rcstate->regparse != '|' &&
- *rcstate->regparse != ')') {
- latest = regpiece(&flags, rcstate);
- if (latest == NULL)
- return(NULL);
- *flagp |= flags&HASWIDTH;
- if (chain == NULL) /* First piece. */
- *flagp |= flags&SPSTART;
- else
- regtail(chain, latest);
- chain = latest;
- }
- if (chain == NULL) /* Loop ran zero times. */
- (void) regnode(NOTHING,rcstate);
-
- return(ret);
-}
-
-/*
- - regpiece - something followed by possible [*+?]
- *
- * Note that the branching code sequences used for ? and the general cases
- * of * and + are somewhat optimized: they use the same NOTHING node as
- * both the endmarker for their branch list and the body of the last branch.
- * It might seem that this node could be dispensed with entirely, but the
- * endmarker role is not redundant.
- */
-static char *
-regpiece(flagp, rcstate)
-int *flagp;
-struct regcomp_state *rcstate;
-{
- register char *ret;
- register char op;
- register char *next;
- int flags;
-
- ret = regatom(&flags,rcstate);
- if (ret == NULL)
- return(NULL);
-
- op = *rcstate->regparse;
- if (!ISMULT(op)) {
- *flagp = flags;
- return(ret);
- }
-
- if (!(flags&HASWIDTH) && op != '?')
- FAIL("*+ operand could be empty");
- *flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);
-
- if (op == '*' && (flags&SIMPLE))
- reginsert(STAR, ret, rcstate);
- else if (op == '*') {
- /* Emit x* as (x&|), where & means "self". */
- reginsert(BRANCH, ret, rcstate); /* Either x */
- regoptail(ret, regnode(BACK,rcstate)); /* and loop */
- regoptail(ret, ret); /* back */
- regtail(ret, regnode(BRANCH,rcstate)); /* or */
- regtail(ret, regnode(NOTHING,rcstate)); /* null. */
- } else if (op == '+' && (flags&SIMPLE))
- reginsert(PLUS, ret, rcstate);
- else if (op == '+') {
- /* Emit x+ as x(&|), where & means "self". */
- next = regnode(BRANCH,rcstate); /* Either */
- regtail(ret, next);
- regtail(regnode(BACK,rcstate), ret); /* loop back */
- regtail(next, regnode(BRANCH,rcstate)); /* or */
- regtail(ret, regnode(NOTHING,rcstate)); /* null. */
- } else if (op == '?') {
- /* Emit x? as (x|) */
- reginsert(BRANCH, ret, rcstate); /* Either x */
- regtail(ret, regnode(BRANCH,rcstate)); /* or */
- next = regnode(NOTHING,rcstate); /* null. */
- regtail(ret, next);
- regoptail(ret, next);
- }
- rcstate->regparse++;
- if (ISMULT(*rcstate->regparse))
- FAIL("nested *?+");
-
- return(ret);
-}
-
-/*
- - regatom - the lowest level
- *
- * Optimization: gobbles an entire sequence of ordinary characters so that
- * it can turn them into a single node, which is smaller to store and
- * faster to run. Backslashed characters are exceptions, each becoming a
- * separate node; the code is simpler that way and it's not worth fixing.
- */
-static char *
-regatom(flagp, rcstate)
-int *flagp;
-struct regcomp_state *rcstate;
-{
- register char *ret;
- int flags;
-
- *flagp = WORST; /* Tentatively. */
-
- switch (*rcstate->regparse++) {
- case '^':
- ret = regnode(BOL,rcstate);
- break;
- case '$':
- ret = regnode(EOL,rcstate);
- break;
- case '.':
- ret = regnode(ANY,rcstate);
- *flagp |= HASWIDTH|SIMPLE;
- break;
- case '[': {
- register int clss;
- register int classend;
-
- if (*rcstate->regparse == '^') { /* Complement of range. */
- ret = regnode(ANYBUT,rcstate);
- rcstate->regparse++;
- } else
- ret = regnode(ANYOF,rcstate);
- if (*rcstate->regparse == ']' || *rcstate->regparse == '-')
- regc(*rcstate->regparse++,rcstate);
- while (*rcstate->regparse != '\0' && *rcstate->regparse != ']') {
- if (*rcstate->regparse == '-') {
- rcstate->regparse++;
- if (*rcstate->regparse == ']' || *rcstate->regparse == '\0')
- regc('-',rcstate);
- else {
- clss = UCHARAT(rcstate->regparse-2)+1;
- classend = UCHARAT(rcstate->regparse);
- if (clss > classend+1)
- FAIL("invalid [] range");
- for (; clss <= classend; clss++)
- regc((char)clss,rcstate);
- rcstate->regparse++;
- }
- } else
- regc(*rcstate->regparse++,rcstate);
- }
- regc('\0',rcstate);
- if (*rcstate->regparse != ']')
- FAIL("unmatched []");
- rcstate->regparse++;
- *flagp |= HASWIDTH|SIMPLE;
- }
- break;
- case '(':
- ret = reg(1, &flags, rcstate);
- if (ret == NULL)
- return(NULL);
- *flagp |= flags&(HASWIDTH|SPSTART);
- break;
- case '\0':
- case '|':
- case ')':
- FAIL("internal urp"); /* Supposed to be caught earlier. */
- /* NOTREACHED */
- case '?':
- case '+':
- case '*':
- FAIL("?+* follows nothing");
- /* NOTREACHED */
- case '\\':
- if (*rcstate->regparse == '\0')
- FAIL("trailing \\");
- ret = regnode(EXACTLY,rcstate);
- regc(*rcstate->regparse++,rcstate);
- regc('\0',rcstate);
- *flagp |= HASWIDTH|SIMPLE;
- break;
- default: {
- register int len;
- register char ender;
-
- rcstate->regparse--;
- len = strcspn(rcstate->regparse, META);
- if (len <= 0)
- FAIL("internal disaster");
- ender = *(rcstate->regparse+len);
- if (len > 1 && ISMULT(ender))
- len--; /* Back off clear of ?+* operand. */
- *flagp |= HASWIDTH;
- if (len == 1)
- *flagp |= SIMPLE;
- ret = regnode(EXACTLY,rcstate);
- while (len > 0) {
- regc(*rcstate->regparse++,rcstate);
- len--;
- }
- regc('\0',rcstate);
- }
- break;
- }
-
- return(ret);
-}
-
-/*
- - regnode - emit a node
- */
-static char * /* Location. */
-regnode(op, rcstate)
-int op;
-struct regcomp_state *rcstate;
-{
- register char *ret;
- register char *ptr;
-
- ret = rcstate->regcode;
- if (ret == &regdummy) {
- rcstate->regsize += 3;
- return(ret);
- }
-
- ptr = ret;
- *ptr++ = (char)op;
- *ptr++ = '\0'; /* Null "next" pointer. */
- *ptr++ = '\0';
- rcstate->regcode = ptr;
-
- return(ret);
-}
-
-/*
- - regc - emit (if appropriate) a byte of code
- */
-static void
-regc(b, rcstate)
-int b;
-struct regcomp_state *rcstate;
-{
- if (rcstate->regcode != &regdummy)
- *rcstate->regcode++ = (char)b;
- else
- rcstate->regsize++;
-}
-
-/*
- - reginsert - insert an operator in front of already-emitted operand
- *
- * Means relocating the operand.
- */
-static void
-reginsert(op, opnd, rcstate)
-int op;
-char *opnd;
-struct regcomp_state *rcstate;
-{
- register char *src;
- register char *dst;
- register char *place;
-
- if (rcstate->regcode == &regdummy) {
- rcstate->regsize += 3;
- return;
- }
-
- src = rcstate->regcode;
- rcstate->regcode += 3;
- dst = rcstate->regcode;
- while (src > opnd)
- *--dst = *--src;
-
- place = opnd; /* Op node, where operand used to be. */
- *place++ = (char)op;
- *place++ = '\0';
- *place = '\0';
-}
-
-/*
- - regtail - set the next-pointer at the end of a node chain
- */
-static void
-regtail(p, val)
-char *p;
-char *val;
-{
- register char *scan;
- register char *temp;
- register int offset;
-
- if (p == &regdummy)
- return;
-
- /* Find last node. */
- scan = p;
- for (;;) {
- temp = regnext(scan);
- if (temp == NULL)
- break;
- scan = temp;
- }
-
- if (OP(scan) == BACK)
- offset = scan - val;
- else
- offset = val - scan;
- *(scan+1) = (char)((offset>>8)&0377);
- *(scan+2) = (char)(offset&0377);
-}
-
-/*
- - regoptail - regtail on operand of first argument; nop if operandless
- */
-static void
-regoptail(p, val)
-char *p;
-char *val;
-{
- /* "Operandless" and "op != BRANCH" are synonymous in practice. */
- if (p == NULL || p == &regdummy || OP(p) != BRANCH)
- return;
- regtail(OPERAND(p), val);
-}
-
-/*
- * TclRegExec and friends
- */
-
-/*
- * Global work variables for TclRegExec().
- */
-struct regexec_state {
- char *reginput; /* String-input pointer. */
- char *regbol; /* Beginning of input, for ^ check. */
- char **regstartp; /* Pointer to startp array. */
- char **regendp; /* Ditto for endp. */
-};
-
-/*
- * Forwards.
- */
-static int regtry _ANSI_ARGS_((regexp *prog, char *string,
- struct regexec_state *restate));
-static int regmatch _ANSI_ARGS_((char *prog,
- struct regexec_state *restate));
-static int regrepeat _ANSI_ARGS_((char *p,
- struct regexec_state *restate));
-
-#ifdef DEBUG
-int regnarrate = 0;
-void regdump _ANSI_ARGS_((regexp *r));
-static char *regprop _ANSI_ARGS_((char *op));
-#endif
-
-/*
- - TclRegExec - match a regexp against a string
- */
-int
-TclRegExec(prog, string, start)
-register regexp *prog;
-register char *string;
-char *start;
-{
- register char *s;
- struct regexec_state state;
- struct regexec_state *restate= &state;
-
- /* Be paranoid... */
- if (prog == NULL || string == NULL) {
- TclRegError("NULL parameter");
- return(0);
- }
-
- /* Check validity of program. */
- if (UCHARAT(prog->program) != MAGIC) {
- TclRegError("corrupted program");
- return(0);
- }
-
- /* If there is a "must appear" string, look for it. */
- if (prog->regmust != NULL) {
- s = string;
- while ((s = strchr(s, prog->regmust[0])) != NULL) {
- if (strncmp(s, prog->regmust, (size_t) prog->regmlen)
- == 0)
- break; /* Found it. */
- s++;
- }
- if (s == NULL) /* Not present. */
- return(0);
- }
-
- /* Mark beginning of line for ^ . */
- restate->regbol = start;
-
- /* Simplest case: anchored match need be tried only once. */
- if (prog->reganch)
- return(regtry(prog, string, restate));
-
- /* Messy cases: unanchored match. */
- s = string;
- if (prog->regstart != '\0')
- /* We know what char it must start with. */
- while ((s = strchr(s, prog->regstart)) != NULL) {
- if (regtry(prog, s, restate))
- return(1);
- s++;
- }
- else
- /* We don't -- general case. */
- do {
- if (regtry(prog, s, restate))
- return(1);
- } while (*s++ != '\0');
-
- /* Failure. */
- return(0);
-}
-
-/*
- - regtry - try match at specific point
- */
-static int /* 0 failure, 1 success */
-regtry(prog, string, restate)
-regexp *prog;
-char *string;
-struct regexec_state *restate;
-{
- register int i;
- register char **sp;
- register char **ep;
-
- restate->reginput = string;
- restate->regstartp = prog->startp;
- restate->regendp = prog->endp;
-
- sp = prog->startp;
- ep = prog->endp;
- for (i = NSUBEXP; i > 0; i--) {
- *sp++ = NULL;
- *ep++ = NULL;
- }
- if (regmatch(prog->program + 1,restate)) {
- prog->startp[0] = string;
- prog->endp[0] = restate->reginput;
- return(1);
- } else
- return(0);
-}
-
-/*
- - regmatch - main matching routine
- *
- * Conceptually the strategy is simple: check to see whether the current
- * node matches, call self recursively to see whether the rest matches,
- * and then act accordingly. In practice we make some effort to avoid
- * recursion, in particular by going through "ordinary" nodes (that don't
- * need to know whether the rest of the match failed) by a loop instead of
- * by recursion.
- */
-static int /* 0 failure, 1 success */
-regmatch(prog, restate)
-char *prog;
-struct regexec_state *restate;
-{
- register char *scan; /* Current node. */
- char *next; /* Next node. */
-
- scan = prog;
-#ifdef DEBUG
- if (scan != NULL && regnarrate)
- fprintf(stderr, "%s(\n", regprop(scan));
-#endif
- while (scan != NULL) {
-#ifdef DEBUG
- if (regnarrate)
- fprintf(stderr, "%s...\n", regprop(scan));
-#endif
- next = regnext(scan);
-
- switch (OP(scan)) {
- case BOL:
- if (restate->reginput != restate->regbol) {
- return 0;
- }
- break;
- case EOL:
- if (*restate->reginput != '\0') {
- return 0;
- }
- break;
- case ANY:
- if (*restate->reginput == '\0') {
- return 0;
- }
- restate->reginput++;
- break;
- case EXACTLY: {
- register int len;
- register char *opnd;
-
- opnd = OPERAND(scan);
- /* Inline the first character, for speed. */
- if (*opnd != *restate->reginput) {
- return 0 ;
- }
- len = strlen(opnd);
- if (len > 1 && strncmp(opnd, restate->reginput, (size_t) len)
- != 0) {
- return 0;
- }
- restate->reginput += len;
- break;
- }
- case ANYOF:
- if (*restate->reginput == '\0'
- || strchr(OPERAND(scan), *restate->reginput) == NULL) {
- return 0;
- }
- restate->reginput++;
- break;
- case ANYBUT:
- if (*restate->reginput == '\0'
- || strchr(OPERAND(scan), *restate->reginput) != NULL) {
- return 0;
- }
- restate->reginput++;
- break;
- case NOTHING:
- break;
- case BACK:
- break;
- case OPEN+1:
- case OPEN+2:
- case OPEN+3:
- case OPEN+4:
- case OPEN+5:
- case OPEN+6:
- case OPEN+7:
- case OPEN+8:
- case OPEN+9: {
- register int no;
- register char *save;
-
- doOpen:
- no = OP(scan) - OPEN;
- save = restate->reginput;
-
- if (regmatch(next,restate)) {
- /*
- * Don't set startp if some later invocation of the
- * same parentheses already has.
- */
- if (restate->regstartp[no] == NULL) {
- restate->regstartp[no] = save;
- }
- return 1;
- } else {
- return 0;
- }
- }
- case CLOSE+1:
- case CLOSE+2:
- case CLOSE+3:
- case CLOSE+4:
- case CLOSE+5:
- case CLOSE+6:
- case CLOSE+7:
- case CLOSE+8:
- case CLOSE+9: {
- register int no;
- register char *save;
-
- doClose:
- no = OP(scan) - CLOSE;
- save = restate->reginput;
-
- if (regmatch(next,restate)) {
- /*
- * Don't set endp if some later
- * invocation of the same parentheses
- * already has.
- */
- if (restate->regendp[no] == NULL)
- restate->regendp[no] = save;
- return 1;
- } else {
- return 0;
- }
- }
- case BRANCH: {
- register char *save;
-
- if (OP(next) != BRANCH) { /* No choice. */
- next = OPERAND(scan); /* Avoid recursion. */
- } else {
- do {
- save = restate->reginput;
- if (regmatch(OPERAND(scan),restate))
- return(1);
- restate->reginput = save;
- scan = regnext(scan);
- } while (scan != NULL && OP(scan) == BRANCH);
- return 0;
- }
- break;
- }
- case STAR:
- case PLUS: {
- register char nextch;
- register int no;
- register char *save;
- register int min;
-
- /*
- * Lookahead to avoid useless match attempts
- * when we know what character comes next.
- */
- nextch = '\0';
- if (OP(next) == EXACTLY)
- nextch = *OPERAND(next);
- min = (OP(scan) == STAR) ? 0 : 1;
- save = restate->reginput;
- no = regrepeat(OPERAND(scan),restate);
- while (no >= min) {
- /* If it could work, try it. */
- if (nextch == '\0' || *restate->reginput == nextch)
- if (regmatch(next,restate))
- return(1);
- /* Couldn't or didn't -- back up. */
- no--;
- restate->reginput = save + no;
- }
- return(0);
- }
- case END:
- return(1); /* Success! */
- default:
- if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) {
- goto doOpen;
- } else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) {
- goto doClose;
- }
- TclRegError("memory corruption");
- return 0;
- }
-
- scan = next;
- }
-
- /*
- * We get here only if there's trouble -- normally "case END" is
- * the terminating point.
- */
- TclRegError("corrupted pointers");
- return(0);
-}
-
-/*
- - regrepeat - repeatedly match something simple, report how many
- */
-static int
-regrepeat(p, restate)
-char *p;
-struct regexec_state *restate;
-{
- register int count = 0;
- register char *scan;
- register char *opnd;
-
- scan = restate->reginput;
- opnd = OPERAND(p);
- switch (OP(p)) {
- case ANY:
- count = strlen(scan);
- scan += count;
- break;
- case EXACTLY:
- while (*opnd == *scan) {
- count++;
- scan++;
- }
- break;
- case ANYOF:
- while (*scan != '\0' && strchr(opnd, *scan) != NULL) {
- count++;
- scan++;
- }
- break;
- case ANYBUT:
- while (*scan != '\0' && strchr(opnd, *scan) == NULL) {
- count++;
- scan++;
- }
- break;
- default: /* Oh dear. Called inappropriately. */
- TclRegError("internal foulup");
- count = 0; /* Best compromise. */
- break;
- }
- restate->reginput = scan;
-
- return(count);
-}
-
-/*
- - regnext - dig the "next" pointer out of a node
- */
-static char *
-regnext(p)
-register char *p;
-{
- register int offset;
-
- if (p == &regdummy)
- return(NULL);
-
- offset = NEXT(p);
- if (offset == 0)
- return(NULL);
-
- if (OP(p) == BACK)
- return(p-offset);
- else
- return(p+offset);
-}
-
-#ifdef DEBUG
-
-static char *regprop();
-
-/*
- - regdump - dump a regexp onto stdout in vaguely comprehensible form
- */
-void
-regdump(r)
-regexp *r;
-{
- register char *s;
- register char op = EXACTLY; /* Arbitrary non-END op. */
- register char *next;
-
-
- s = r->program + 1;
- while (op != END) { /* While that wasn't END last time... */
- op = OP(s);
- printf("%2d%s", s-r->program, regprop(s)); /* Where, what. */
- next = regnext(s);
- if (next == NULL) /* Next ptr. */
- printf("(0)");
- else
- printf("(%d)", (s-r->program)+(next-s));
- s += 3;
- if (op == ANYOF || op == ANYBUT || op == EXACTLY) {
- /* Literal string, where present. */
- while (*s != '\0') {
- putchar(*s);
- s++;
- }
- s++;
- }
- putchar('\n');
- }
-
- /* Header fields of interest. */
- if (r->regstart != '\0')
- printf("start `%c' ", r->regstart);
- if (r->reganch)
- printf("anchored ");
- if (r->regmust != NULL)
- printf("must have \"%s\"", r->regmust);
- printf("\n");
-}
-
-/*
- - regprop - printable representation of opcode
- */
-static char *
-regprop(op)
-char *op;
-{
- register char *p;
- static char buf[50];
-
- (void) strcpy(buf, ":");
-
- switch (OP(op)) {
- case BOL:
- p = "BOL";
- break;
- case EOL:
- p = "EOL";
- break;
- case ANY:
- p = "ANY";
- break;
- case ANYOF:
- p = "ANYOF";
- break;
- case ANYBUT:
- p = "ANYBUT";
- break;
- case BRANCH:
- p = "BRANCH";
- break;
- case EXACTLY:
- p = "EXACTLY";
- break;
- case NOTHING:
- p = "NOTHING";
- break;
- case BACK:
- p = "BACK";
- break;
- case END:
- p = "END";
- break;
- case OPEN+1:
- case OPEN+2:
- case OPEN+3:
- case OPEN+4:
- case OPEN+5:
- case OPEN+6:
- case OPEN+7:
- case OPEN+8:
- case OPEN+9:
- sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
- p = NULL;
- break;
- case CLOSE+1:
- case CLOSE+2:
- case CLOSE+3:
- case CLOSE+4:
- case CLOSE+5:
- case CLOSE+6:
- case CLOSE+7:
- case CLOSE+8:
- case CLOSE+9:
- sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
- p = NULL;
- break;
- case STAR:
- p = "STAR";
- break;
- case PLUS:
- p = "PLUS";
- break;
- default:
- if (OP(op) > OPEN && OP(op) < OPEN+NSUBEXP) {
- sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
- p = NULL;
- break;
- } else if (OP(op) > CLOSE && OP(op) < CLOSE+NSUBEXP) {
- sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
- p = NULL;
- } else {
- TclRegError("corrupted opcode");
- }
- break;
- }
- if (p != NULL)
- (void) strcat(buf, p);
- return(buf);
-}
-#endif
-
-/*
- * The following is provided for those people who do not have strcspn() in
- * their C libraries. They should get off their butts and do something
- * about it; at least one public-domain implementation of those (highly
- * useful) string routines has been published on Usenet.
- */
-#ifdef STRCSPN
-/*
- * strcspn - find length of initial segment of s1 consisting entirely
- * of characters not from s2
- */
-
-static int
-strcspn(s1, s2)
-char *s1;
-char *s2;
-{
- register char *scan1;
- register char *scan2;
- register int count;
-
- count = 0;
- for (scan1 = s1; *scan1 != '\0'; scan1++) {
- for (scan2 = s2; *scan2 != '\0';) /* ++ moved down. */
- if (*scan1 == *scan2++)
- return(count);
- count++;
- }
- return(count);
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * TclRegError --
- *
- * This procedure is invoked by the regexp code when an error
- * occurs. It saves the error message so it can be seen by the
- * code that called Spencer's code.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The value of "string" is saved in "errMsg".
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclRegError(string)
- char *string; /* Error message. */
-{
- errMsg = string;
-}
-
-char *
-TclGetRegError()
-{
- return errMsg;
-}
diff --git a/generic/regfree.c b/generic/regfree.c
new file mode 100644
index 0000000..a5c3f0b
--- /dev/null
+++ b/generic/regfree.c
@@ -0,0 +1,25 @@
+/*
+ * regfree - free an RE
+ *
+ * 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/generic/regfronts.c b/generic/regfronts.c
new file mode 100644
index 0000000..a9bd556
--- /dev/null
+++ b/generic/regfronts.c
@@ -0,0 +1,56 @@
+/*
+ * regcomp and regexec - front ends to re_ routines
+ *
+ * Mostly for implementation of backward-compatibility kludges. Note
+ * that these routines exist ONLY in char versions.
+ */
+
+#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/generic/regguts.h b/generic/regguts.h
new file mode 100644
index 0000000..badd8d4
--- /dev/null
+++ b/generic/regguts.h
@@ -0,0 +1,388 @@
+/*
+ * Internal interface definitions, etc., for the regex package
+ */
+
+
+
+/*
+ * 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
+#include <assert.h>
+#endif
+#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
+
+/* 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 */
+};
+
+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 */
+ int 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 */
+ int usedshorter; /* used non-greedy quantifiers? */
+ int unmatchable; /* cannot match anything? */
+};
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 11058d2..671f5ff 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -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: tcl.decls,v 1.7 1999/03/11 02:49:33 stanton Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.8 1999/04/16 00:46:41 stanton Exp $
library tcl
@@ -35,7 +35,7 @@ declare 1 generic {
int exact, ClientData *clientDataPtr)
}
declare 2 generic {
- void panic(char *format, ...)
+ void Tcl_Panic(char *format, ...)
}
declare 3 generic {
char * Tcl_Alloc(unsigned int size)
@@ -123,7 +123,8 @@ declare 27 generic {
Tcl_Obj * Tcl_DbNewObj(char *file, int line)
}
declare 28 generic {
- Tcl_Obj * Tcl_DbNewStringObj(char *bytes, int length, char *file, int line)
+ Tcl_Obj * Tcl_DbNewStringObj(CONST char *bytes, int length, \
+ char *file, int line)
}
declare 29 generic {
Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr)
@@ -132,7 +133,7 @@ declare 30 generic {
void TclFreeObj(Tcl_Obj *objPtr)
}
declare 31 generic {
- int Tcl_GetBoolean(Tcl_Interp *interp, char *string, int *boolPtr)
+ int Tcl_GetBoolean(Tcl_Interp *interp, char *str, int *boolPtr)
}
declare 32 generic {
int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
@@ -142,7 +143,7 @@ declare 33 generic {
unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 34 generic {
- int Tcl_GetDouble(Tcl_Interp *interp, char *string, double *doublePtr)
+ int Tcl_GetDouble(Tcl_Interp *interp, char *str, double *doublePtr)
}
declare 35 generic {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, \
@@ -153,7 +154,7 @@ declare 36 generic {
char **tablePtr, char *msg, int flags, int *indexPtr)
}
declare 37 generic {
- int Tcl_GetInt(Tcl_Interp *interp, char *string, int *intPtr)
+ int Tcl_GetInt(Tcl_Interp *interp, char *str, int *intPtr)
}
declare 38 generic {
int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
@@ -215,10 +216,10 @@ declare 55 generic {
Tcl_Obj * Tcl_NewObj(void)
}
declare 56 generic {
- Tcl_Obj *Tcl_NewStringObj(char *bytes, int length)
+ Tcl_Obj *Tcl_NewStringObj(CONST char *bytes, int length)
}
declare 57 generic {
- void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
+ void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
declare 58 generic {
unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
@@ -230,31 +231,32 @@ declare 60 generic {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
declare 61 generic {
- void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
+ void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
declare 62 generic {
- void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[])
+ void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[])
}
declare 63 generic {
- void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
+ 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)
+ void Tcl_SetStringObj(Tcl_Obj *objPtr, char *bytes, int length)
}
declare 66 generic {
- void Tcl_AddErrorInfo(Tcl_Interp *interp, char *message)
+ void Tcl_AddErrorInfo(Tcl_Interp *interp, CONST char *message)
}
declare 67 generic {
- void Tcl_AddObjErrorInfo(Tcl_Interp *interp, char *message, int length)
+ 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, char *string)
+ void Tcl_AppendElement(Tcl_Interp *interp, CONST char *string)
}
declare 70 generic {
void Tcl_AppendResult(Tcl_Interp *interp, ...)
@@ -421,8 +423,7 @@ declare 116 generic {
void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData)
}
declare 117 generic {
- char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *string, \
- int length)
+ char * Tcl_DStringAppend(Tcl_DString *dsPtr, CONST char *str, int length)
}
declare 118 generic {
char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, CONST char *string)
@@ -477,19 +478,19 @@ declare 134 generic {
char *cmdName)
}
declare 135 generic {
- int Tcl_ExprBoolean(Tcl_Interp *interp, char *string, int *ptr)
+ 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 *string, double *ptr)
+ 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 *string, long *ptr)
+ int Tcl_ExprLong(Tcl_Interp *interp, char *str, long *ptr)
}
declare 140 generic {
int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr)
@@ -505,7 +506,7 @@ declare 143 generic {
void Tcl_Finalize(void)
}
declare 144 generic {
- void Tcl_FindExecutable(char *argv0)
+ void Tcl_FindExecutable(CONST char *argv0)
}
declare 145 generic {
Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, \
@@ -519,11 +520,13 @@ declare 147 generic {
}
declare 148 generic {
int Tcl_GetAlias(Tcl_Interp *interp, char *slaveCmd, \
- Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *argcPtr, char ***argvPtr)
+ 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)
+ Tcl_Interp **targetInterpPtr, char **targetCmdPtr, int *objcPtr, \
+ Tcl_Obj ***objv)
}
declare 150 generic {
ClientData Tcl_GetAssocData(Tcl_Interp *interp, char *name, \
@@ -586,7 +589,7 @@ declare 166 generic {
# generic interface, so we inlcude it here for compatibility reasons.
declare 167 unix {
- int Tcl_GetOpenFile(Tcl_Interp *interp, char *string, int write, \
+ int Tcl_GetOpenFile(Tcl_Interp *interp, char *str, int write, \
int checkUsage, ClientData *filePtr)
}
@@ -736,11 +739,11 @@ declare 212 generic {
Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, char *string)
}
declare 213 generic {
- int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, char *string, \
- char *start)
+ 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 *string, char *pattern)
+ int Tcl_RegExpMatch(Tcl_Interp *interp, char *str, char *pattern)
}
declare 215 generic {
void Tcl_RegExpRange(Tcl_RegExp regexp, int index, char **startPtr, \
@@ -753,10 +756,10 @@ declare 217 generic {
void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 generic {
- int Tcl_ScanElement(CONST char *string, int *flagPtr)
+ int Tcl_ScanElement(CONST char *str, int *flagPtr)
}
declare 219 generic {
- int Tcl_ScanCountedElement(CONST char *string, int length, int *flagPtr)
+ int Tcl_ScanCountedElement(CONST char *str, int length, int *flagPtr)
}
declare 220 generic {
int Tcl_Seek(Tcl_Channel chan, int offset, int mode)
@@ -798,7 +801,7 @@ declare 231 generic {
int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}
declare 232 generic {
- void Tcl_SetResult(Tcl_Interp *interp, char *string, \
+ void Tcl_SetResult(Tcl_Interp *interp, char *str, \
Tcl_FreeProc *freeProc)
}
declare 233 generic {
@@ -831,18 +834,18 @@ declare 241 generic {
void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 generic {
- int Tcl_SplitList(Tcl_Interp *interp, char *list, int *argcPtr, \
+ int Tcl_SplitList(Tcl_Interp *interp, CONST char *listStr, int *argcPtr, \
char ***argvPtr)
}
declare 243 generic {
- void Tcl_SplitPath(char *path, int *argcPtr, char ***argvPtr)
+ 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(char *string, char *pattern)
+ int Tcl_StringMatch(CONST char *str, CONST char *pattern)
}
declare 246 generic {
int Tcl_Tell(Tcl_Channel chan)
@@ -928,7 +931,7 @@ declare 269 generic {
char * Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 generic {
- char * Tcl_ParseVar(Tcl_Interp *interp, char *string, char **termPtr)
+ char * Tcl_ParseVar(Tcl_Interp *interp, char *str, char **termPtr)
}
declare 271 generic {
char * Tcl_PkgPresent(Tcl_Interp *interp, char *name, char *version, \
@@ -955,14 +958,16 @@ declare 277 generic {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
declare 278 generic {
- void panicVA(char *format, va_list argList)
+ 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)
+}
+
# Reserved for future use (8.0.x vs. 8.1)
-# declare 280 generic {
-# }
# declare 281 generic {
# }
# declare 282 generic {
@@ -974,6 +979,278 @@ declare 279 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, size_t 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)
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
@@ -981,6 +1258,18 @@ declare 279 generic {
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
@@ -1030,4 +1319,3 @@ declare 7 mac {
declare 8 mac {
int strcasecmp(CONST char *s1, CONST char *s2)
}
-
diff --git a/generic/tcl.h b/generic/tcl.h
index 9a56498..2a8be54 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -5,14 +5,14 @@
* 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-1999 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.
*
- * RCS: @(#) $Id: tcl.h,v 1.38 1999/03/12 23:03:51 stanton Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.39 1999/04/16 00:46:42 stanton Exp $
*/
#ifndef _TCL
@@ -30,24 +30,25 @@
* 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
+ * win/pkgIndex.tcl (for tclregNN.dll, not patchlevel)
+ * README
* mac/README
- *
+ * win/README.binary
+ * win/README (only if major.minor changes, not patchlevel)
+ * unix/README (only if major.minor changes, not patchlevel)
*/
#define TCL_MAJOR_VERSION 8
-#define TCL_MINOR_VERSION 0
-#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 5
+#define TCL_MINOR_VERSION 1
+#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE
+#define TCL_RELEASE_SERIAL 3
-#define TCL_VERSION "8.0"
-#define TCL_PATCH_LEVEL "8.0.5"
+#define TCL_VERSION "8.1"
+#define TCL_PATCH_LEVEL "8.1b3"
/*
* The following definitions set up the proper options for Windows
@@ -99,6 +100,7 @@
# ifndef NO_STRERROR
# define NO_STRERROR 1
# endif
+# define INLINE
#endif
/*
@@ -129,6 +131,29 @@
# 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_ConditionNotify(condPtr)
+#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+#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
@@ -222,10 +247,14 @@
/*
* Definitions that allow this header file to be used either with or
- * without ANSI C features like function prototypes. */
+ * without ANSI C features like function prototypes.
+ */
#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
@@ -322,9 +351,15 @@ 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;
@@ -395,6 +430,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));
@@ -414,7 +454,7 @@ 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,
@@ -468,8 +508,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
@@ -520,7 +560,7 @@ 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.
*/
@@ -544,6 +584,23 @@ EXTERN int Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));
#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).
@@ -665,13 +722,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).
@@ -687,13 +752,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
@@ -718,7 +784,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:
@@ -731,45 +809,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.
- */
-
-#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__)
-
-#else
-
-/*
- * If USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of
- * the native malloc/free. The only time USE_TCLALLOC should not be
- * true is when compiling the Tcl/Tk libraries on Unix systems. In this
- * case we can safely call the native malloc/free directly as a performance
- * optimization.
- */
-
-# 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.
@@ -960,6 +999,21 @@ 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)
+
+/*
* Typedefs for the various operations in a channel type:
*/
@@ -967,6 +1021,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,
@@ -986,6 +1042,43 @@ typedef int (Tcl_DriverGetHandleProc) _ANSI_ARGS_((
ClientData *handlePtr));
/*
+ * 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 USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of
+ * the native malloc/free. The only time USE_TCLALLOC should not be
+ * true is when compiling the Tcl/Tk libraries on Unix systems. In this
+ * case we can safely call the native malloc/free directly as a performance
+ * optimization.
+ */
+
+# 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_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.
*/
@@ -1011,8 +1104,10 @@ typedef struct Tcl_ChannelType {
Tcl_DriverBlockModeProc *blockModeProc;
/* Set blocking mode for the
* raw channel. May be NULL. */
- Tcl_DriverCloseProc *closeProc; /* Procedure to call to close
- * the channel. */
+ 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. */
Tcl_DriverOutputProc *outputProc; /* Procedure to call for output
@@ -1028,7 +1123,10 @@ typedef struct Tcl_ChannelType {
Tcl_DriverGetHandleProc *getHandleProc;
/* Get an OS handle from the channel
* or NULL if not supported. */
- VOID *reserved; /* reserved for future expansion */
+ Tcl_DriverClose2Proc *close2Proc; /* Procedure to call to close the
+ * channel if the device supports
+ * closing the read & write sides
+ * independently. */
} Tcl_ChannelType;
/*
@@ -1052,6 +1150,298 @@ typedef enum Tcl_PathType {
} Tcl_PathType;
/*
+ * 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
+
+/*
+ * 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. */
+
+ /*
+ * 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.
*/
@@ -1061,18 +1451,15 @@ typedef enum Tcl_PathType {
#define Tcl_Ckrealloc Tcl_Realloc
#define Tcl_Return Tcl_SetResult
#define Tcl_TildeSubst Tcl_TranslateFileName
-
-/*
- * In later releases, Tcl_Panic will be the correct name to use. For now
- * we leave it as panic to avoid breaking existing binaries.
- */
-
-#define Tcl_Panic panic
-#define Tcl_PanicVA panicVA
+#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
@@ -1088,6 +1475,18 @@ typedef enum Tcl_PathType {
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.
@@ -1099,7 +1498,6 @@ EXTERN char * Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
* Public functions that are not accessible via the stubs table.
*/
-EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
Tcl_AppInitProc *appInitProc));
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 9314c2a..c44cf9f 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -8,13 +8,14 @@
*
* 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.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAlloc.c,v 1.5 1999/03/11 02:49:34 stanton Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.6 1999/04/16 00:46:42 stanton Exp $
*/
#include "tclInt.h"
@@ -31,7 +32,7 @@
typedef unsigned long caddr_t;
/*
- * 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 +44,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 +53,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 +85,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 TclpMutex allocMutex;
+#endif
+static int allocInit = 0;
+
+
#ifdef MSTATS
/*
@@ -106,6 +139,89 @@ 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;
+ TclpMutexInit(&allocMutex);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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;
+
+ TclpMutexLock(&allocMutex);
+ 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
+ TclpMutexUnlock(&allocMutex);
+}
/*
*----------------------------------------------------------------------
@@ -124,21 +240,41 @@ 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!
+ */
+
+ allocInit = 1;
+ TclpMutexInit(&allocMutex);
+ }
+ TclpMutexLock(&allocMutex);
/*
* 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) {
+ TclpMutexUnlock(&allocMutex);
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 +289,7 @@ TclpAlloc(
op->ov_rmagic = RMAGIC;
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ TclpMutexUnlock(&allocMutex);
return (void *)(op+1);
}
/*
@@ -170,6 +307,7 @@ TclpAlloc(
while (nbytes + OVERHEAD > amt) {
amt <<= 1;
if (amt == 0) {
+ TclpMutexUnlock(&allocMutex);
return (NULL);
}
bucket++;
@@ -183,6 +321,7 @@ TclpAlloc(
if ((op = nextf[bucket]) == NULL) {
MoreCore(bucket);
if ((op = nextf[bucket]) == NULL) {
+ TclpMutexUnlock(&allocMutex);
return (NULL);
}
}
@@ -204,6 +343,7 @@ TclpAlloc(
op->ov_rmagic = RMAGIC;
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ TclpMutexUnlock(&allocMutex);
return ((char *)(op + 1));
}
@@ -214,6 +354,8 @@ TclpAlloc(
*
* Allocate more memory to the indicated bucket.
*
+ * Assumes Mutex is already held.
+ *
* Results:
* None.
*
@@ -224,13 +366,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 +386,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 +426,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;
}
+ TclpMutexLock(&allocMutex);
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) {
+ TclpMutexUnlock(&allocMutex);
return;
}
@@ -303,7 +454,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);
+ TclpMutexUnlock(&allocMutex);
return;
}
ASSERT(size < NBUCKETS);
@@ -312,6 +467,7 @@ TclpFree(
#ifdef MSTATS
nmalloc[size]--;
#endif
+ TclpMutexUnlock(&allocMutex);
}
/*
@@ -331,12 +487,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 +501,14 @@ TclpRealloc(
return (TclpAlloc(nbytes));
}
+ TclpMutexLock(&allocMutex);
+
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) {
+ TclpMutexUnlock(&allocMutex);
return NULL;
}
@@ -361,10 +521,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) {
+ TclpMutexUnlock(&allocMutex);
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 +554,7 @@ TclpRealloc(
op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ TclpMutexUnlock(&allocMutex);
return (char *)(op+1);
}
maxsize = 1 << (i+3);
@@ -388,7 +567,9 @@ TclpRealloc(
if (expensive) {
void *newp;
-
+
+ TclpMutexUnlock(&allocMutex);
+
newp = TclpAlloc(nbytes);
if ( newp == NULL ) {
return NULL;
@@ -408,6 +589,7 @@ TclpRealloc(
op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
#endif
+ TclpMutexUnlock(&allocMutex);
return(cp);
}
@@ -431,14 +613,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;
+ TclpMutexLock(&allocMutex);
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,11 +637,11 @@ mstats(
totused, totfree);
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
MAXMALLOC, nmalloc[NBUCKETS]);
+ TclpMutexUnlock(&allocMutex);
}
#endif
-#else /* !USE_TCLALLOC */
-
+#else /* !USE_TCLALLOC */
/*
*----------------------------------------------------------------------
@@ -477,8 +660,8 @@ mstats(
*/
char *
-TclpAlloc(
- unsigned int nbytes) /* Number of bytes to allocate. */
+TclpAlloc(nbytes)
+ unsigned int nbytes; /* Number of bytes to allocate. */
{
return (char*) malloc(nbytes);
}
@@ -500,8 +683,8 @@ TclpAlloc(
*/
void
-TclpFree(
- char *cp) /* Pointer to memory to free. */
+TclpFree(cp)
+ char *cp; /* Pointer to memory to free. */
{
free(cp);
return;
@@ -524,9 +707,9 @@ 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. */
{
return (char*) realloc(cp, nbytes);
}
diff --git a/generic/tclAsync.c b/generic/tclAsync.c
index 18af186..fc80385 100644
--- a/generic/tclAsync.c
+++ b/generic/tclAsync.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclAsync.c,v 1.3 1999/03/11 00:19:23 stanton Exp $
+ * RCS: @(#) $Id: tclAsync.c,v 1.4 1999/04/16 00:46:42 stanton Exp $
*/
#include "tclInt.h"
@@ -43,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
@@ -92,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;
}
@@ -124,11 +128,13 @@ void
Tcl_AsyncMark(async)
Tcl_AsyncHandler async; /* Token for handler. */
{
+ Tcl_MutexLock(&asyncMutex);
((AsyncHandler *) async)->ready = 1;
if (!asyncActive) {
- TclpAsyncMark(async);
asyncReady = 1;
+ TclpAsyncMark(async);
}
+ Tcl_MutexUnlock(&asyncMutex);
}
/*
@@ -161,8 +167,10 @@ Tcl_AsyncInvoke(interp, code)
* just completed. */
{
AsyncHandler *asyncPtr;
+ Tcl_MutexLock(&asyncMutex);
if (asyncReady == 0) {
+ Tcl_MutexUnlock(&asyncMutex);
return code;
}
asyncReady = 0;
@@ -193,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;
}
@@ -223,6 +234,7 @@ Tcl_AsyncDelete(async)
AsyncHandler *asyncPtr = (AsyncHandler *) async;
AsyncHandler *prevPtr;
+ Tcl_MutexLock(&asyncMutex);
if (firstHandler == asyncPtr) {
firstHandler = asyncPtr->nextPtr;
if (firstHandler == NULL) {
@@ -238,6 +250,7 @@ Tcl_AsyncDelete(async)
lastHandler = prevPtr;
}
}
+ Tcl_MutexUnlock(&asyncMutex);
ckfree((char *) asyncPtr);
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 24c7189..e673a3c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.18 1999/03/11 02:49:34 stanton Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.19 1999/04/16 00:46:42 stanton Exp $
*/
#include "tclInt.h"
@@ -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,7 +191,7 @@ 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_CmdProc *) NULL, Tcl_OpenObjCmd,
(CompileProc *) NULL, 0},
@@ -194,21 +199,21 @@ static CmdInfo builtInCmds[] = {
(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,35 +238,7 @@ static CmdInfo builtInCmds[] = {
{NULL, (Tcl_CmdProc *) NULL, (Tcl_ObjCmdProc *) NULL,
(CompileProc *) NULL, 0}
};
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitStubs --
- *
- * Ensures that the correct version of Tcl is loaded. This is
- * a trivial implementation of the stubs library initializer
- * that will get called if a stubs aware extension is directly
- * linked with the Tcl library.
- *
- * Results:
- * The actual version of Tcl that satisfies the request, or
- * NULL to indicate that an error occurred.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-char *
-Tcl_InitStubs (interp, version, exact)
- Tcl_Interp *interp;
- char *version;
- int exact;
-{
- return Tcl_PkgRequire(interp, "Tcl", version, exact);
-}
/*
*----------------------------------------------------------------------
@@ -285,14 +262,23 @@ Tcl_InitStubs (interp, version, exact)
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
@@ -310,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;
@@ -327,9 +318,11 @@ 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;
@@ -339,6 +332,7 @@ Tcl_CreateInterp()
iPtr->packageUnknown = NULL;
iPtr->cmdCount = 0;
iPtr->termOffset = 0;
+ TclInitLiteralTable(&(iPtr->literalTable));
iPtr->compileEpoch = 0;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
@@ -353,26 +347,63 @@ 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));
+
+ statsPtr->currentInstBytes = 0.0;
+ statsPtr->currentLitBytes = 0.0;
+ statsPtr->currentExceptBytes = 0.0;
+ statsPtr->currentAuxBytes = 0.0;
+ statsPtr->currentCmdMapBytes = 0.0;
- iPtr->execEnvPtr = TclCreateExecEnv((Tcl_Interp *) iPtr);
+ 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 = tclStubsPtr;
+ iPtr->stubTable = &tclStubs;
+
/*
* Create the core commands. Do it here, rather than calling
@@ -428,72 +459,93 @@ 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,
- TCL_GLOBAL_ONLY);
- Tcl_TraceVar2((Tcl_Interp *) iPtr, "tcl_precision", (char *) NULL,
- TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- TclPrecTraceProc, (ClientData) NULL);
+#ifndef TCL_GENERIC_ONLY
+ TclSetupEnv(interp);
+#endif
/*
* Compute the byte order of this machine.
*/
order.s = 1;
- Tcl_SetVar2((Tcl_Interp *) iPtr, "tcl_platform", "byteOrder",
- (order.c[0] == 1) ? "littleEndian" : "bigEndian",
+ Tcl_SetVar2(interp, "tcl_platform", "byteOrder",
+ ((order.c[0] == 1) ? "littleEndian" : "bigEndian"),
TCL_GLOBAL_ONLY);
/*
+ * 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);
+
+ /*
* Register Tcl's version number.
*/
- Tcl_PkgProvideEx((Tcl_Interp *) iPtr, "Tcl", TCL_VERSION,
- (ClientData) tclStubsPtr);
+ 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;
}
/*
@@ -562,13 +614,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));
@@ -763,6 +820,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
@@ -789,7 +922,6 @@ DeleteInterpProc(interp)
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
Tcl_HashTable *hTablePtr;
- AssocData *dPtr;
ResolverScheme *resPtr, *nextResPtr;
int i;
@@ -810,6 +942,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
@@ -822,6 +956,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.
*/
@@ -838,6 +993,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);
@@ -911,187 +1068,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 --
*
@@ -1099,14 +1086,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
@@ -1118,7 +1105,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;
@@ -1189,14 +1176,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;
}
/*
@@ -1205,7 +1190,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",
@@ -1265,7 +1250,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.
@@ -1284,7 +1269,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) {
@@ -1311,24 +1296,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,
@@ -1508,7 +1483,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));
@@ -1562,7 +1537,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
@@ -1760,7 +1735,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) {
@@ -1768,7 +1742,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;
@@ -1861,11 +1835,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);
/*
@@ -2436,83 +2408,92 @@ 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.
@@ -2534,27 +2515,59 @@ 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;
/*
+ * Prevent the object from being deleted as a side effect of evaling it.
+ */
+
+ 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).
+ */
+
+ char *p;
+ int length;
+
+ p = Tcl_GetStringFromObj(objPtr, &length);
+ result = Tcl_EvalEx(interp, p, length, flags);
+ Tcl_DecrRefCount(objPtr);
+ return result;
+ }
+
+ 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
* result if there are no commands in the command string.
@@ -2571,21 +2584,23 @@ Tcl_EvalObj(interp, objPtr)
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;
}
/*
@@ -2597,9 +2612,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;
}
/*
@@ -2624,12 +2640,12 @@ 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)
|| (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;
@@ -2639,15 +2655,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;
@@ -2657,7 +2680,7 @@ Tcl_EvalObj(interp, objPtr)
* Resetting the flags must be done after any compilation.
*/
- flags = iPtr->evalFlags;
+ evalFlags = iPtr->evalFlags;
iPtr->evalFlags = 0;
/*
@@ -2665,8 +2688,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.
@@ -2679,7 +2702,6 @@ Tcl_EvalObj(interp, objPtr)
TclCleanupByteCode(codePtr);
}
} else {
- Tcl_ResetResult(interp);
result = TCL_OK;
}
@@ -2690,33 +2712,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;
}
}
@@ -2727,33 +2739,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);
}
/*
@@ -2763,13 +2749,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 --
*
@@ -2778,15 +2865,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
@@ -2824,12 +2911,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 */
@@ -2878,12 +2962,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 */
@@ -2931,12 +3012,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 */
@@ -3044,9 +3122,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 */
}
@@ -3123,11 +3198,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);
/*
@@ -3215,15 +3288,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;
@@ -3255,15 +3328,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. */
@@ -3287,35 +3360,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;
@@ -3376,7 +3438,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);
@@ -3408,13 +3472,14 @@ TclObjInvoke(interp, objc, objv, flags)
*/
if (localObjv != (Tcl_Obj **) NULL) {
+ Tcl_DecrRefCount(localObjv[0]);
ckfree((char *) localObjv);
}
return result;
}
/*
- *--------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_ExprString --
*
@@ -3422,17 +3487,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
@@ -3444,7 +3508,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) {
@@ -3468,24 +3532,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 */
@@ -3535,15 +3594,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
@@ -3556,72 +3642,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) {
@@ -3632,28 +3699,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.
@@ -3664,6 +3746,8 @@ Tcl_ExprObj(interp, objPtr, resultPtrPtr)
codePtr->refCount--;
if (codePtr->refCount <= 0) {
TclCleanupByteCode(codePtr);
+ objPtr->typePtr = NULL;
+ objPtr->internalRep.otherValuePtr = NULL;
}
/*
@@ -3679,17 +3763,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;
}
@@ -3844,7 +3920,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);
}
@@ -3876,29 +3952,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);
@@ -3922,16 +3995,14 @@ 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_VarEvalVA --
*
@@ -3939,13 +4010,13 @@ Tcl_AddObjErrorInfo(interp, message, length)
* 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.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
int
@@ -4011,14 +4082,14 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_GlobalEval --
*
* Evaluate a command at global level in an interpreter.
*
* Results:
- * A standard Tcl result is returned, and interp->result is
+ * A standard Tcl result is returned, and the interp's result is
* modified accordingly.
*
* Side effects:
@@ -4027,7 +4098,7 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
* procedures active), just as if an "uplevel #0" command were
* being executed.
*
- *----------------------------------------------------------------------
+ ---------------------------------------------------------------------------
*/
int
@@ -4049,51 +4120,6 @@ Tcl_GlobalEval(interp, command)
/*
*----------------------------------------------------------------------
*
- * Tcl_GlobalEvalObj --
- *
- * Execute Tcl commands stored in a Tcl object at global level in
- * an interpreter. These commands are compiled into bytecodes if
- * necessary.
- *
- * Results:
- * A standard Tcl result is returned, and the interpreter's result
- * contains a Tcl object value to supplement the return code.
- *
- * 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
- * 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. */
-{
- register Interp *iPtr = (Interp *) interp;
- int result;
- CallFrame *savedVarFramePtr;
-
- savedVarFramePtr = iPtr->varFramePtr;
- iPtr->varFramePtr = NULL;
- result = Tcl_EvalObj(interp, objPtr);
- iPtr->varFramePtr = savedVarFramePtr;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* Tcl_SetRecursionLimit --
*
* Set the maximum number of recursive calls that may be active
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index e6d5d31..5156465 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.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: tclBinary.c,v 1.4 1999/03/10 05:52:46 stanton Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.5 1999/04/16 00:46:42 stanton Exp $
*/
#include <math.h>
@@ -36,17 +36,35 @@ static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int GetFormatSpec _ANSI_ARGS_((char **formatPtr,
char *cmdPtr, int *countPtr));
-static Tcl_Obj * ScanNumber _ANSI_ARGS_((unsigned 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. This type should
- * be used to represent arbitrary binary data instead of a string object
- * because although they are equivalent at the moment they will not be in
- * future versions which support unicode.
+ * 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 = {
@@ -87,12 +105,8 @@ typedef struct ByteArray {
*
* Tcl_NewByteArrayObj --
*
- * This procedure is normally called when not debugging: i.e., when
- * TCL_MEM_DEBUG is not defined. It creates a new ByteArray object and
- * initializes it from the given array of bytes.
- *
- * When TCL_MEM_DEBUG is defined, this procedure just returns the
- * result of calling the debugging version Tcl_DbNewByteArrayObj.
+ * 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
@@ -108,6 +122,7 @@ typedef struct ByteArray {
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewByteArrayObj
+
Tcl_Obj *
Tcl_NewByteArrayObj(bytes, length)
unsigned char *bytes; /* The array of bytes used to initialize
@@ -197,7 +212,7 @@ Tcl_DbNewByteArrayObj(bytes, length, file, line)
return Tcl_NewByteArrayObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */
-
+
/*
*---------------------------------------------------------------------------
*
@@ -355,17 +370,23 @@ SetByteArrayFromAny(interp, objPtr)
{
Tcl_ObjType *typePtr;
int length;
- char *src;
+ 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));
- memcpy((VOID *) byteArrayPtr->bytes, (VOID *) src, (size_t) length);
+ for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ *dst++ = (unsigned char) ch;
+ }
- byteArrayPtr->used = length;
+ byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
if ((typePtr != NULL) && (typePtr->freeIntRepProc) != NULL) {
@@ -465,7 +486,7 @@ UpdateStringOfByteArray(objPtr)
Tcl_Obj *objPtr; /* ByteArray object whose string rep to
* update. */
{
- int length;
+ int i, length, size;
unsigned char *src;
char *dst;
ByteArray *byteArrayPtr;
@@ -475,15 +496,29 @@ UpdateStringOfByteArray(objPtr)
length = byteArrayPtr->used;
/*
- * The byte array is the string representation.
+ * How much space will string rep need?
*/
-
- dst = (char *) ckalloc((unsigned) (length + 1));
+
+ 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 = length;
+ objPtr->length = size;
- memcpy((VOID *) dst, (VOID *) src, (size_t) length);
- dst[length] = '\0';
+ 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';
+ }
}
/*
@@ -523,37 +558,43 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
unsigned char *maxPos; /* Greatest position within result buffer that
* cursor has visited.*/
char *errorString, *errorValue, *str;
- int offset, size, length;
-
- 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;
}
@@ -563,10 +604,10 @@ 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) {
@@ -586,24 +627,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;
}
@@ -628,23 +674,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;
}
@@ -656,7 +707,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
offset -= count;
break;
- case '@':
+ }
+ case '@': {
if (offset > length) {
length = offset;
}
@@ -668,15 +720,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;
}
}
}
@@ -694,7 +741,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
resultPtr = Tcl_GetObjResult(interp);
buffer = Tcl_SetByteArrayLength(resultPtr, length);
- memset(buffer, 0, (size_t) length);
+ memset((VOID *) buffer, 0, (size_t) length);
/*
* Pack the data into the result object. Note that we can skip
@@ -703,7 +750,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) {
@@ -733,7 +780,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
memcpy((VOID *) cursor, (VOID *) bytes,
(size_t) length);
- memset(cursor+length, pad,
+ memset((VOID *) (cursor + length), pad,
(size_t) (count - length));
}
cursor += count;
@@ -765,7 +812,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto badValue;
}
if (((offset + 1) % 8) == 0) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
value = 0;
}
}
@@ -779,7 +826,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
goto badValue;
}
if (!((offset + 1) % 8)) {
- *cursor++ = (char)(value & 0xff);
+ *cursor++ = (unsigned char) value;
value = 0;
}
}
@@ -790,7 +837,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';
@@ -817,15 +864,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;
@@ -834,17 +884,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;
}
}
@@ -855,7 +909,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
} else {
value >>= 4;
}
- *cursor++ = (char) value;
+ *cursor++ = (unsigned char) value;
}
while (cursor < last) {
@@ -899,14 +953,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;
}
@@ -920,7 +975,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
cursor -= count;
}
break;
- case '@':
+ }
+ case '@': {
if (cursor > maxPos) {
maxPos = cursor;
}
@@ -930,11 +986,12 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
cursor = buffer + count;
}
break;
+ }
}
}
break;
-
- case BinaryScan: {
+ }
+ case BINARY_SCAN: {
int i;
Tcl_Obj *valuePtr, *elementPtr;
@@ -944,11 +1001,12 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
- format = Tcl_GetStringFromObj(objv[3], NULL);
+ 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;
}
@@ -956,7 +1014,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
case 'a':
case 'A': {
unsigned char *src;
-
+
if (arg >= objc) {
goto badIndex;
}
@@ -987,9 +1045,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
}
valuePtr = Tcl_NewByteArrayObj(src, 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;
@@ -1006,19 +1064,19 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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;
}
}
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++) {
@@ -1040,9 +1098,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
}
- 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;
@@ -1052,8 +1110,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
case 'h':
case 'H': {
- unsigned char *src;
char *dest;
+ unsigned char *src;
int i;
static char hexdigit[] = "0123456789abcdef";
@@ -1073,7 +1131,7 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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++) {
@@ -1095,9 +1153,9 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
}
}
- 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;
@@ -1105,27 +1163,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': {
unsigned char *src;
-
+
size = sizeof(double);
/* fall through */
- scanNumber:
+ scanNumber:
if (arg >= objc) {
goto badIndex;
}
@@ -1153,16 +1215,16 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
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;
}
@@ -1173,7 +1235,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset += count;
}
break;
- case 'X':
+ }
+ case 'X': {
if (count == BINARY_NOCOUNT) {
count = 1;
}
@@ -1183,7 +1246,8 @@ Tcl_BinaryObjCmd(dummy, interp, objc, objv)
offset -= count;
}
break;
- case '@':
+ }
+ case '@': {
if (count == BINARY_NOCOUNT) {
goto badCount;
}
@@ -1193,15 +1257,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;
}
}
}
@@ -1232,9 +1291,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;
}
@@ -1290,7 +1358,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;
@@ -1325,9 +1393,8 @@ FormatNumber(interp, type, src, cursorPtr)
{
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.
@@ -1336,9 +1403,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;
@@ -1353,31 +1420,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;
@@ -1406,7 +1473,7 @@ ScanNumber(buffer, type)
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
@@ -1416,37 +1483,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
@@ -1457,16 +1532,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/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 61d4623..f19d597 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -5,14 +5,15 @@
* 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.
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.3 1999/03/10 05:52:47 stanton Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.4 1999/04/16 00:46:42 stanton Exp $
*/
#include "tclInt.h"
@@ -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 TclpMutex ckallocMutex;
+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 environtment,
+ * such as during TclInitSubsystems.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TclInitDbCkalloc()
+{
+ if (!ckallocInit) {
+ ckallocInit = 1;
+ TclpMutexInit(&ckallocMutex);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclDumpMemoryInfo --
* Display the global memory management statistics.
*
@@ -164,7 +206,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 +227,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 */
}
}
@@ -222,9 +264,15 @@ Tcl_ValidateAllMemory (file, line)
{
struct mem_header *memScanP;
- for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink)
+ if (!ckallocInit) {
+ ckallocInit = 1;
+ TclpMutexInit(&ckallocMutex);
+ }
+ TclpMutexLock(&ckallocMutex);
+ for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
ValidateMemory(memScanP, file, line, FALSE);
-
+ }
+ TclpMutexUnlock(&ckallocMutex);
}
/*
@@ -246,10 +294,16 @@ Tcl_DumpActiveMemory (fileName)
struct mem_header *memScanP;
char *address;
- fileP = fopen(fileName, "w");
- if (fileP == NULL)
- return TCL_ERROR;
+ if (fileName == NULL) {
+ fileP = stdout;
+ } else {
+ fileP = fopen(fileName, "w");
+ if (fileP == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ TclpMutexLock(&ckallocMutex);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body [0];
fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
@@ -259,7 +313,11 @@ Tcl_DumpActiveMemory (fileName)
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
}
- fclose (fileP);
+ TclpMutexUnlock(&ckallocMutex);
+
+ if (fileP != stderr) {
+ fclose (fileP);
+ }
return TCL_OK;
}
@@ -313,6 +371,11 @@ 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) {
+ ckallocInit = 1;
+ TclpMutexInit(&ckallocMutex);
+ }
+ TclpMutexLock(&ckallocMutex);
result->length = size;
result->tagPtr = curTagPtr;
if (curTagPtr != NULL) {
@@ -322,6 +385,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 +421,8 @@ Tcl_DbCkalloc(size, file, line)
if (current_bytes_malloced > maximum_bytes_malloced)
maximum_bytes_malloced = current_bytes_malloced;
+ TclpMutexUnlock(&ckallocMutex);
+
return result->body;
}
@@ -403,6 +469,7 @@ Tcl_DbCkfree(ptr, file, line)
if (validate_memory)
Tcl_ValidateAllMemory(file, line);
+ TclpMutexLock(&ckallocMutex);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
memset((VOID *) ptr, GUARD_VALUE, (size_t) memp->length);
@@ -429,6 +496,8 @@ Tcl_DbCkfree(ptr, file, line)
if (allocHead == memp)
allocHead = memp->flink;
TclpFree((char *) memp);
+ TclpMutexUnlock(&ckallocMutex);
+
return 0;
}
@@ -580,7 +649,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,6 +724,42 @@ 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.
*
@@ -657,11 +769,19 @@ void
Tcl_InitMemory(interp)
Tcl_Interp *interp;
{
+ TclInitDbCkalloc();
Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
+ Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
+ (Tcl_CmdDeleteProc *) NULL);
}
-#else /* TCL_MEM_DEBUG */
+
+#else /* TCL_MEM_DEBUG */
+
+#undef Tcl_InitMemory
+#undef Tcl_DumpActiveMemory
+#undef Tcl_ValidateAllMemory
/*
@@ -778,8 +898,8 @@ Tcl_DbCkfree(ptr, file, line)
/*
*----------------------------------------------------------------------
*
- * Tcl_InitMemory, et al. --
- * Dummy implementations of memory routines, which is only available
+ * Tcl_InitMemory --
+ * Dummy initialization for memory command, which is only available
* if TCL_MEM_DEBUG is on.
*
*----------------------------------------------------------------------
@@ -791,9 +911,6 @@ Tcl_InitMemory(interp)
{
}
-#undef Tcl_DumpActiveMemory
-#undef Tcl_ValidateAllMemory
-
int
Tcl_DumpActiveMemory(fileName)
char *fileName;
@@ -814,4 +931,44 @@ TclDumpMemoryInfo(outFile)
{
}
-#endif /* TCL_MEM_DEBUG */
+#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
+ TclpMutexLock(&ckallocMutex);
+ if (tclMemDumpFileName != NULL) {
+ Tcl_DumpActiveMemory(tclMemDumpFileName);
+ }
+ if (curTagPtr != NULL) {
+ TclpFree((char *) curTagPtr);
+ }
+ allocHead = NULL;
+ TclpMutexUnlock(&ckallocMutex);
+#endif
+
+#if USE_TCLALLOC
+ TclFinalizeAllocSubsystem();
+#endif
+}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index bd96000..2015f53 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclClock.c,v 1.3 1999/03/10 05:52:47 stanton Exp $
+ * RCS: @(#) $Id: tclClock.c,v 1.4 1999/04/16 00:46:43 stanton Exp $
*/
#include "tcl.h"
@@ -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:
*/
@@ -172,13 +178,16 @@ 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;
@@ -222,11 +231,12 @@ FormatClock(interp, clockVal, useGMT, format)
Tcl_DString buffer;
int bufSize;
char *p;
-#ifdef TCL_USE_TIMEZONE_VAR
- int savedTimeZone;
- char *savedTZEnv;
-#endif
Tcl_Obj *resultPtr;
+ int result;
+#ifndef HAVE_TM_ZONE
+ int savedTimeZone = 0; /* lint. */
+ char *savedTZEnv = NULL; /* lint. */
+#endif
resultPtr = Tcl_GetObjResult(interp);
#ifdef HAVE_TZSET
@@ -235,18 +245,21 @@ FormatClock(interp, clockVal, useGMT, format)
*/
static int calledTzset = 0;
+ Tcl_MutexLock(&clockMutex);
if (!calledTzset) {
tzset();
calledTzset = 1;
}
+ Tcl_MutexUnlock(&clockMutex);
#endif
-#ifdef TCL_USE_TIMEZONE_VAR
+#ifndef HAVE_TM_ZONE
/*
- * 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).
+ * 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;
@@ -280,14 +293,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);
@@ -299,6 +310,11 @@ FormatClock(interp, clockVal, useGMT, format)
tzset();
}
#endif
+ if ((result == 0) && (*format != '\0')) {
+ Tcl_AppendStringsToObj(resultPtr, "bad format string \"", format,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
Tcl_SetStringObj(resultPtr, buffer.string, -1);
Tcl_DStringFree(&buffer);
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index fd31e52..8aa6880 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,24 +11,36 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.4 1998/12/23 02:01:42 rjohnson Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.5 1999/04/16 00:46:43 stanton Exp $
*/
#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);
}
@@ -251,11 +258,11 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv)
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,8 +308,7 @@ 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) {
@@ -311,17 +317,23 @@ Tcl_CdObjCmd(dummy, interp, objc, objv)
}
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,7 +613,7 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
}
if (objc == 2) {
- result = Tcl_EvalObj(interp, objv[1]);
+ result = Tcl_EvalObjEx(interp, objv[1], 0);
} else {
/*
* More than one argument: concatenate them together with spaces
@@ -489,11 +621,13 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
*/
objPtr = Tcl_ConcatObj(objc-1, objv+1);
- result = Tcl_EvalObj(interp, objPtr);
- Tcl_DecrRefCount(objPtr); /* we're done with the object */
+ Tcl_IncrRefCount(objPtr);
+ result = Tcl_EvalObjEx(interp, objPtr, 0);
+ Tcl_DecrRefCount(objPtr);
}
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 +707,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 +729,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 +785,86 @@ 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", "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_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;
+
if (objc != 3) {
- errorString = "dirname name";
- goto not3Args;
+ goto only3Args;
+ }
+ if (GetStatBuf(interp, objv[2], TclpStat, &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_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 +873,209 @@ 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;
+ goto only3Args;
}
- 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;
+ value = 0;
+ if (GetStatBuf(NULL, objv[2], TclpStat, &buf) == TCL_OK) {
+ value = S_ISDIR(buf.st_mode);
}
- goto done;
- case FILE_SPLIT: {
- int pargc, i;
- char **pargvList;
- Tcl_Obj *listObjPtr;
-
- if (objc != 3) {
- errorString = "split name";
- goto not3Args;
- }
-
- 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], TclpStat, &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;
+ case FILE_MTIME: {
+ struct stat buf;
- for (i = 0; i < objc; i++) {
- pargv[i] = Tcl_GetStringFromObj(objv[i], &length);
+ if (objc != 3) {
+ goto only3Args;
}
- 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], TclpStat, &buf) != TCL_OK) {
+ return TCL_ERROR;
}
- goto done;
- }
-
- /*
- * Next, handle operations that can be satisfied with the "access"
- * kernel call.
- */
+ Tcl_SetLongObj(resultPtr, (long) buf.st_mtime);
+ return TCL_OK;
+ }
+ case FILE_MKDIR: {
+ char **argv;
+ int result;
- 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 < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
+ 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));
- }
- 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], TclpStat, &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 +1087,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_SIZE:
+ case FILE_RENAME: {
+ int result;
+ char **argv;
+
+ argv = StringifyObjects(objc, objv);
+ result = TclFileRenameCmd(interp, objc, argv);
+ ckfree((char *) argv);
+ return result;
+ }
+ 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], TclpStat, &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], TclpStat, &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);
-not3Args:
- Tcl_WrongNumArgs(interp, 1, objv, errorString);
- result = TCL_ERROR;
- goto done;
+ 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;
+ }
+
+ 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 +1395,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 +1411,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 +1448,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 +1517,7 @@ GetTypeFromMode(mode)
/*
*----------------------------------------------------------------------
*
- * Tcl_ForCmd --
+ * Tcl_FoObjCmd --
*
* This procedure is invoked to process the "for" Tcl command.
* See the user documentation for details on what it does.
@@ -1333,21 +1538,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 +1559,24 @@ Tcl_ForCmd(dummy, interp, argc, argv)
return result;
}
while (1) {
- result = Tcl_ExprBoolean(interp, argv[2], &value);
+ 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 +1695,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 +1766,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 +1775,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 +1783,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 +1791,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 +1847,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 +1870,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 +1894,12 @@ 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. */
/*
* This procedure is a bit nasty. The goal is to use sprintf to
@@ -1695,7 +1907,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 +1915,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 +1928,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
register char *newPtr = newFormat;
width = precision = noPercent = useShort = 0;
+ gotMinus = gotPrecision = 0;
whichValue = PTR_VALUE;
/*
@@ -1748,7 +1960,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 +1969,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 +1994,30 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
xpgCheckDone:
while ((*format == '-') || (*format == '#') || (*format == '0')
|| (*format == ' ') || (*format == '+')) {
+ if (*format == '-') {
+ gotMinus = 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 +2033,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 +2042,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 +2086,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 +2140,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 +2169,68 @@ 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;
+ ptr = dst;
+ if (!gotMinus) {
+ for ( ; --width > 0; ptr++) {
+ *ptr = ' ';
+ }
+ }
+ ptr += Tcl_UniCharToUtf(intValue, ptr);
+ for ( ; --width > 0; ptr++) {
+ *ptr = ' ';
+ }
+ *ptr = '\0';
+ break;
+ }
+ case STRING_VALUE: {
+ char *ptr;
+ 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++ = ' ';
+ pad--;
+ }
+ }
+
+ size = Tcl_UtfAtIndex(ptrValue, stringLen) - ptrValue;
+ if (size) {
+ memcpy(ptr, ptrValue, (size_t) size);
+ ptr += size;
+ }
+ while (pad > 0) {
+ *ptr++ = ' ';
+ pad--;
+ }
+ *ptr = '\0';
+ break;
+ }
+ default: {
+ sprintf(dst, newFormat, ptrValue);
+ break;
}
- } else {
- sprintf(dst, newFormat, ptrValue);
}
Tcl_AppendToObj(resultPtr, dst, -1);
}
@@ -1975,3 +2263,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/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 25b563b..6db0c53 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,12 +14,13 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.11 1999/02/03 00:55:04 stanton Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.12 1999/04/16 00:46:43 stanton Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
+#include "tclRegexp.h"
/*
* During execution of the "lsort" command, structures of the following
@@ -45,7 +46,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 +150,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 +170,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 +227,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 +247,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 +291,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 +375,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 ...?");
@@ -472,7 +492,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),
@@ -533,7 +553,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),
@@ -664,8 +684,9 @@ InfoCommandsCmd(dummy, interp, objc, objv)
Namespace *dummy1NsPtr, *dummy2NsPtr;
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
+
+ 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 */
@@ -812,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) {
@@ -828,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);
@@ -841,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;
@@ -893,9 +914,9 @@ InfoExistsCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- varName = Tcl_GetStringFromObj(objv[2], (int *) NULL);
+ varName = Tcl_GetString(objv[2]);
varPtr = TclLookupVar(interp, varName, (char *) NULL,
- TCL_PARSE_PART1, "access",
+ 0, "access",
/*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
@@ -943,7 +964,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;
@@ -1064,7 +1085,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;
}
@@ -1173,7 +1194,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;
@@ -1214,7 +1235,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;
@@ -1427,13 +1448,13 @@ InfoProcsCmd(dummy, interp, objc, objv)
Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
register Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
- Command *cmdPtr;
+ Command *cmdPtr, *realCmdPtr;
Tcl_Obj *listPtr;
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;
@@ -1450,7 +1471,17 @@ InfoProcsCmd(dummy, interp, objc, objv)
entryPtr = Tcl_NextHashEntry(&search)) {
cmdName = Tcl_GetHashKey(&currNsPtr->cmdTable, entryPtr);
cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
- if (TclIsProc(cmdPtr)) {
+
+ /*
+ * If the command isn't itself a proc, it still might be an
+ * imported command that points to a "real" proc in a different
+ * namespace.
+ */
+
+ realCmdPtr = (Command *) TclGetOriginalCommand(
+ (Tcl_Command) cmdPtr);
+ if (TclIsProc(cmdPtr)
+ || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
if ((pattern == NULL) || Tcl_StringMatch(cmdName, pattern)) {
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(cmdName, -1));
@@ -1646,9 +1677,10 @@ InfoVarsCmd(dummy, interp, objc, objv)
Namespace *dummy1NsPtr, *dummy2NsPtr;
- pattern = Tcl_GetStringFromObj(objv[2], (int *) NULL);
- TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
- /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
+ 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);
@@ -1913,7 +1945,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;
@@ -2247,7 +2279,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;
}
@@ -2303,19 +2335,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
char *bytes, *patternBytes;
- int i, match, mode, index, result, listLen, length, elemLen;
- Tcl_Obj **elemPtrs;
- static char *switches[] =
- {"-exact", "-glob", "-regexp", (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) {
@@ -2328,46 +2361,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:
+ bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+ switch ((enum options) mode) {
+ case LSEARCH_EXACT: {
if (length == elemLen) {
match = (memcmp(bytes, patternBytes,
(size_t) length) == 0);
}
break;
- case GLOB:
- /*
- * WARNING: will not work with data containing NULLs.
- */
+ }
+ case LSEARCH_GLOB: {
match = Tcl_StringMatch(bytes, patternBytes);
break;
- case REGEXP:
- /*
- * WARNING: will not work with data containing NULLs.
- */
- match = Tcl_RegExpMatch(interp, bytes, patternBytes);
+ }
+ case LSEARCH_REGEXP: {
+ match = TclRegExpMatchObj(interp, bytes, patObj);
if (match < 0) {
return TCL_ERROR;
}
break;
+ }
}
- if (match) {
+ if (match != 0) {
index = i;
break;
}
}
-
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
return TCL_OK;
}
@@ -2396,7 +2426,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;
Tcl_Obj *resultPtr;
int length;
Tcl_Obj *cmdPtr, **listObjPtrs;
@@ -2477,9 +2507,21 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
}
}
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);
+
+ if (Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj())
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
+ sortInfo.compareCmdPtr = newCommandPtr;
+ Tcl_IncrRefCount(newCommandPtr);
}
sortInfo.resultCode = Tcl_ListObjGetElements(interp, objv[objc-1],
@@ -2513,7 +2555,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
done:
if (sortInfo.sortMode == SORTMODE_COMMAND) {
- Tcl_DStringFree(&sortInfo.compareCmd);
+ Tcl_DecrRefCount(sortInfo.compareCmdPtr);
+ sortInfo.compareCmdPtr = NULL;
}
return sortInfo.resultCode;
}
@@ -2666,9 +2709,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) {
@@ -2705,11 +2748,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;
}
@@ -2737,12 +2779,10 @@ 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;
@@ -2772,22 +2812,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;
@@ -2840,11 +2884,13 @@ static int
DictionaryCompare(left, right)
char *left, *right; /* The strings to compare */
{
+ Tcl_UniChar uniLeft, uniRight;
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
@@ -2880,8 +2926,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 {
/*
@@ -2894,23 +2940,40 @@ DictionaryCompare(left, right)
}
break;
}
- } else if (!isdigit(UCHAR(*left))) {
+ } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
return -1;
}
}
continue;
}
- diff = UCHAR(*left) - UCHAR(*right);
+
+ /*
+ * 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);
+ } else {
+ diff = UCHAR(*left) - UCHAR(*right);
+ break;
+ }
+
+ diff = uniLeft - uniRight;
if (diff) {
- if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
- diff = UCHAR(tolower(*left)) - UCHAR(*right);
- if (diff) {
+ if (Tcl_UniCharIsUpper(uniLeft) &&
+ Tcl_UniCharIsLower(uniRight)) {
+ diff = Tcl_UniCharToLower(uniLeft) - uniRight;
+ 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)));
+ } else if (Tcl_UniCharIsUpper(uniRight)
+ && Tcl_UniCharIsLower(uniLeft)) {
+ diff = uniLeft - Tcl_UniCharToLower(uniRight);
if (diff) {
return diff;
} else if (secondaryDiff == 0) {
@@ -2920,11 +2983,6 @@ DictionaryCompare(left, right)
return diff;
}
}
- if (*left == 0) {
- break;
- }
- left++;
- right++;
}
if (diff == 0) {
diff = secondaryDiff;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 53583a8..38a3f8d 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -8,16 +8,34 @@
*
* 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.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.2 1998/09/14 18:39:57 stanton Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.3 1999/04/16 00:46:43 stanton Exp $
*/
#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,35 +81,35 @@ 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.
+ * See the user documentation for details on what it does. The
+ * REGEXP_TEST stuff is to minimize code differences between this
+ * and the "testregexp" command.
*
* Results:
* A standard Tcl result.
@@ -104,96 +122,124 @@ 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, result, indices, stringLength, wLen, match, about;
+ int cflags, eflags;
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--;
+ char *string;
+ Tcl_DString stringBuffer, valueBuffer;
+ Tcl_UniChar *wStart;
+ static char *options[] = {
+ "-indices", "-nocase", "-about", "-expanded",
+ "-line", "-linestop", "-lineanchor",
+ "--", (char *) NULL
+ };
+ enum options {
+ REGEXP_INDICES, REGEXP_NOCASE, REGEXP_ABOUT, REGEXP_EXPANDED,
+ REGEXP_LINE, REGEXP_LINESTOP, REGEXP_LINEANCHOR,
+ REGEXP_LAST
+ };
+
+ indices = 0;
+ about = 0;
+ cflags = REG_ADVANCED;
+ eflags = 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_INDICES: {
+ indices = 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_NOCASE: {
+ cflags |= REG_ICASE;
+ break;
+ }
+ case REGEXP_ABOUT: {
+ about = 1;
+ break;
+ }
+ case REGEXP_EXPANDED: {
+ cflags |= REG_EXPANDED;
+ break;
+ }
+ case REGEXP_LINE: {
+ cflags |= REG_NEWLINE;
+ break;
+ }
+ case REGEXP_LINESTOP: {
+ cflags |= REG_NLSTOP;
+ break;
+ }
+ case REGEXP_LINEANCHOR: {
+ cflags |= REG_NLANCH;
+ 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;
}
+ objc -= i;
+ objv += i;
+
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if (regExpr == NULL) {
return TCL_ERROR;
}
+
+ if (about) {
+ if (TclRegAbout(interp, regExpr) < 0) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ result = TCL_OK;
+ string = Tcl_GetStringFromObj(objv[1], &stringLength);
+
+ Tcl_DStringInit(&valueBuffer);
+
+ Tcl_DStringInit(&stringBuffer);
+ wStart = Tcl_UtfToUniCharDString(string, stringLength, &stringBuffer);
+ wLen = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);
+
+ match = TclRegExpExecUniChar(interp, regExpr, wStart, wLen, objc-2, eflags);
if (match < 0) {
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
- if (!match) {
- Tcl_SetResult(interp, "0", TCL_STATIC);
- return TCL_OK;
+ if (match == 0) {
+ /*
+ * Set the interpreter's object result to an integer object w/ value 0.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ goto done;
}
/*
@@ -201,51 +247,59 @@ Tcl_RegexpCmd(dummy, interp, argc, argv)
* index information in those variables.
*/
- argc -= 2;
- for (i = 0; i < argc; i++) {
- char *result, info[50];
+ objc -= 2;
+ objv += 2;
+
+ for (i = 0; i < objc; i++) {
+ char *varName, *value;
+ int start, end;
+
+ varName = Tcl_GetString(objv[i]);
- Tcl_RegExpRange(regExpr, i, &start, &end);
- if (start == NULL) {
+ TclRegExpRangeUniChar(regExpr, i, &start, &end);
+ if (start < 0) {
if (indices) {
- result = Tcl_SetVar(interp, argPtr[i+2], "-1 -1", 0);
+ value = Tcl_SetVar(interp, varName, "-1 -1", 0);
} else {
- result = Tcl_SetVar(interp, argPtr[i+2], "", 0);
+ value = Tcl_SetVar(interp, varName, "", 0);
}
} else {
if (indices) {
- sprintf(info, "%d %d", (int)(start - string),
- (int)(end - string - 1));
- result = Tcl_SetVar(interp, argPtr[i+2], info, 0);
+ char info[TCL_INTEGER_SPACE * 2];
+
+ sprintf(info, "%d %d", start, end - 1);
+ value = Tcl_SetVar(interp, varName, info, 0);
} else {
- char savedChar, *first, *last;
-
- 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);
- } else {
- savedChar = *last;
- *last = 0;
- result = Tcl_SetVar(interp, argPtr[i+2], first, 0);
- *last = savedChar;
- }
+ value = Tcl_UniCharToUtfDString(wStart + start, end - start,
+ &valueBuffer);
+ value = Tcl_SetVar(interp, varName, value, 0);
+ Tcl_DStringSetLength(&valueBuffer, 0);
}
}
- if (result == NULL) {
+ if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
- argPtr[i+2], "\"", (char *) NULL);
- return TCL_ERROR;
+ varName, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
}
}
- Tcl_SetResult(interp, "1", TCL_STATIC);
- return TCL_OK;
+
+ /*
+ * Set the interpreter's object result to an integer object w/ value 1.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+
+ done:
+ Tcl_DStringFree(&stringBuffer);
+ Tcl_DStringFree(&valueBuffer);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * 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 +315,74 @@ 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, flags, all, stringLength, numMatches;
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_DString resultBuffer, stringBuffer;
+ CONST Tcl_UniChar *w, *wStart, *wEnd;
+ char *string, *subspec, *varname;
+ static char *options[] = {
+ "-all", "-nocase", "--", NULL
+ };
+ enum options {
+ REGSUB_ALL, REGSUB_NOCASE, REGSUB_LAST
+ };
+
+ flags = 0;
+ all = 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: {
+ flags |= REG_ICASE;
+ 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], flags | REG_ADVANCED);
if (regExpr == NULL) {
- code = TCL_ERROR;
- goto done;
+ return TCL_ERROR;
}
+ result = TCL_OK;
+ string = Tcl_GetStringFromObj(objv[1], &stringLength);
+ subspec = Tcl_GetString(objv[2]);
+ varname = Tcl_GetString(objv[3]);
+
+ Tcl_DStringInit(&resultBuffer);
+
/*
* The following loop is to handle multiple matches within the
* same source string; each iteration handles one match and its
@@ -343,25 +390,39 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
* then the loop body only gets executed once.
*/
+ Tcl_DStringInit(&stringBuffer);
+ wStart = Tcl_UtfToUniCharDString(string, stringLength, &stringBuffer);
+ wEnd = wStart + Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);
+
numMatches = 0;
- for (p = string; *p != 0; ) {
- match = Tcl_RegExpExec(interp, regExpr, p, string);
+ for (w = wStart; w < wEnd; ) {
+ int start, end, subStart, subEnd, match;
+ char *src, *firstChar;
+ char c;
+
+ /*
+ * The flags argument is set if string is part of a larger string,
+ * so that "^" won't match.
+ */
+
+ match = TclRegExpExecUniChar(interp, regExpr, w, wEnd - w, 10,
+ ((w > wStart) ? REG_NOTBOL : 0));
if (match < 0) {
- code = TCL_ERROR;
+ result = TCL_ERROR;
goto done;
}
- if (!match) {
+ if (match == 0) {
break;
}
- numMatches += 1;
+ 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);
+ TclRegExpRangeUniChar(regExpr, 0, &start, &end);
+ Tcl_UniCharToUtfDString(w, start, &resultBuffer);
/*
* Append the subSpec argument to the variable, making appropriate
@@ -369,8 +430,10 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
* 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 +443,10 @@ 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_DStringAppend(&resultBuffer, firstChar,
+ src - firstChar);
+ Tcl_DStringAppend(&resultBuffer, &c, 1);
+ firstChar = src + 2;
src++;
continue;
} else {
@@ -395,42 +456,31 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
continue;
}
if (firstChar != src) {
- c = *src;
- *src = 0;
- Tcl_DStringAppend(&resultDString, firstChar, -1);
- *src = c;
+ Tcl_DStringAppend(&resultBuffer, firstChar, src - firstChar);
}
- 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;
+ TclRegExpRangeUniChar(regExpr, index, &subStart, &subEnd);
+ if ((subStart >= 0) && (subEnd >= 0)) {
+ Tcl_UniCharToUtfDString(w + subStart, subEnd - subStart,
+ &resultBuffer);
}
if (*src == '\\') {
src++;
}
- firstChar = src+1;
+ firstChar = src + 1;
}
if (firstChar != src) {
- Tcl_DStringAppend(&resultDString, firstChar, -1);
+ Tcl_DStringAppend(&resultBuffer, 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_UniCharToUtfDString(w, 1, &resultBuffer);
+ w++;
}
+ w += end;
if (!all) {
break;
}
@@ -441,30 +491,27 @@ Tcl_RegsubCmd(dummy, interp, argc, argv)
* result variable.
*/
- if ((*p != 0) || (numMatches == 0)) {
- Tcl_DStringAppend(&resultDString, argPtr[1] + (p - string), -1);
+ if ((w < wEnd) || (numMatches == 0)) {
+ Tcl_UniCharToUtfDString(w, wEnd - w, &resultBuffer);
}
- if (Tcl_SetVar(interp, argPtr[3], Tcl_DStringValue(&resultDString), 0)
- == NULL) {
- Tcl_AppendResult(interp,
- "couldn't set variable \"", argPtr[3], "\"",
+ if (Tcl_SetVar(interp, varname, Tcl_DStringValue(&resultBuffer),
+ 0) == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"", varname, "\"",
(char *) NULL);
- code = TCL_ERROR;
+ 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_DStringFree(&stringBuffer);
+ Tcl_DStringFree(&resultBuffer);
+ return result;
}
/*
@@ -499,8 +546,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 +588,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 +612,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 +650,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 +680,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 +710,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 +727,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 +780,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.
@@ -1061,14 +808,14 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
static char *options[] = {
"compare", "first", "index", "last",
"length", "match", "range", "tolower",
- "toupper", "trim", "trimleft", "trimright",
- "wordend", "wordstart", NULL
+ "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_WORDEND, STR_WORDSTART
+ STR_TOUPPER, STR_TOTITLE, STR_TRIM, STR_TRIMLEFT,
+ STR_TRIMRIGHT, STR_WORDEND, STR_WORDSTART
};
if (objc < 2) {
@@ -1112,43 +859,67 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
+ /*
+ * This algorithm fails on improperly formed UTF strings.
+ */
+
match = -1;
string1 = Tcl_GetStringFromObj(objv[2], &length1);
string2 = Tcl_GetStringFromObj(objv[3], &length2);
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.
+ */
+
+ if (match != -1) {
+ match = Tcl_NumUtfChars(string2, match);
+ }
Tcl_SetIntObj(resultPtr, match);
break;
}
case STR_INDEX: {
int index;
+ Tcl_UniChar ch;
+ char buf[TCL_UTF_MAX];
+ char *start, *end;
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) {
return TCL_ERROR;
}
- if ((index >= 0) && (index < length1)) {
- Tcl_SetStringObj(resultPtr, string1 + index, 1);
+ if (index >= 0) {
+ start = Tcl_GetStringFromObj(objv[2], &length1);
+ end = start + length1;
+ for ( ; start < end; index--) {
+ start += Tcl_UtfToUniChar(start, &ch);
+ if (index == 0) {
+ Tcl_SetStringObj(resultPtr, buf,
+ Tcl_UniCharToUtf(ch, buf));
+ break;
+ }
+ }
}
break;
}
@@ -1160,6 +931,10 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
goto badFirstLastArgs;
}
+ /*
+ * This algorithm fails on improperly formed UTF strings.
+ */
+
match = -1;
string1 = Tcl_GetStringFromObj(objv[2], &length1);
string2 = Tcl_GetStringFromObj(objv[3], &length2);
@@ -1178,6 +953,15 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
}
}
+
+ /*
+ * Compute the character index of the matching string by counting
+ * the number of characters before the match.
+ */
+
+ if (match != -1) {
+ match = Tcl_NumUtfChars(string2, match);
+ }
Tcl_SetIntObj(resultPtr, match);
break;
}
@@ -1187,8 +971,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- (void) Tcl_GetStringFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, length1);
+ string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ Tcl_SetIntObj(resultPtr, Tcl_NumUtfChars(string1, length1));
break;
}
case STR_MATCH: {
@@ -1211,6 +995,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
string1 = Tcl_GetStringFromObj(objv[2], &length1);
+ length1 = Tcl_NumUtfChars(string1, length1);
if (TclGetIntForIndex(interp, objv[3], length1 - 1,
&first) != TCL_OK) {
return TCL_ERROR;
@@ -1226,39 +1011,17 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
last = length1 - 1;
}
if (last >= first) {
- Tcl_SetStringObj(resultPtr, string1 + first, last - first + 1);
- }
- break;
- }
- case STR_TOLOWER: {
- register char *p, *end;
+ char *start, *end;
- if (objc != 3) {
- Tcl_WrongNumArgs(interp, 2, objv, "string");
- 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 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));
- }
+ start = Tcl_UtfAtIndex(string1, first);
+ end = Tcl_UtfAtIndex(start, last - first + 1);
+ Tcl_SetStringObj(resultPtr, start, end - start);
}
break;
}
- case STR_TOUPPER: {
- register char *p, *end;
-
+ case STR_TOLOWER:
+ case STR_TOUPPER:
+ case STR_TOTITLE:
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "string");
return TCL_ERROR;
@@ -1267,30 +1030,33 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
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.
+ * 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);
- string1 = Tcl_GetStringFromObj(resultPtr, &length1);
- end = string1 + length1;
- for (p = string1; p < end; p++) {
- if (islower(UCHAR(*p))) {
- *p = (char) toupper(UCHAR(*p));
- }
+ if ((enum options) index == STR_TOLOWER) {
+ length1 = Tcl_UtfToLower(Tcl_GetStringFromObj(resultPtr, NULL));
+ } else if ((enum options) index == STR_TOUPPER) {
+ length1 = Tcl_UtfToUpper(Tcl_GetStringFromObj(resultPtr, NULL));
+ } else {
+ length1 = Tcl_UtfToTitle(Tcl_GetStringFromObj(resultPtr, NULL));
}
+ Tcl_SetObjLength(resultPtr, length1);
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 +1071,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 +1098,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 +1128,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");
@@ -1365,23 +1153,30 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if (index < 0) {
index = 0;
}
- cur = length1;
- if (index < length1) {
- for (cur = index; cur < length1; cur++) {
- c = UCHAR(string1[cur]);
- if (!isalnum(c) && (c != '_')) {
+ numChars = Tcl_NumUtfChars(string1, length1);
+ 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");
@@ -1392,16 +1187,19 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if (Tcl_GetIntFromObj(interp, objv[3], &index) != TCL_OK) {
return TCL_ERROR;
}
- if (index >= length1) {
- index = length1 - 1;
+ numChars = Tcl_NumUtfChars(string1, length1);
+ 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 +1215,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 +1233,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 +1295,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,122 +1387,92 @@ 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;
+ char *string, *pattern;
+ 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++;
+
+ string = Tcl_GetString(objv[i]);
+ objc -= i + 1;
+ objv += i + 1;
/*
* If all of the pattern/command pairs are lumped into a single
* argument, split them out again.
*/
- 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;
}
- splitObjs = 1;
+ objv = listv;
}
- for (i = 0; i < switchObjc; i += 2) {
- if (i == (switchObjc-1)) {
+ 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;
+ 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]);
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:
+ case OPT_EXACT:
matched = (strcmp(string, pattern) == 0);
break;
- case GLOB:
+ case OPT_GLOB:
matched = Tcl_StringMatch(string, pattern);
break;
- case REGEXP:
- matched = Tcl_RegExpMatch(interp, string, pattern);
+ case OPT_REGEXP:
+ matched = TclRegExpMatchObj(interp, string, objv[i]);
if (matched < 0) {
- code = TCL_ERROR;
- goto done;
+ return TCL_ERROR;
}
break;
}
}
- if (!matched) {
+ if (matched == 0) {
continue;
}
@@ -1703,53 +1481,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 +1553,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 +1572,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 +1588,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);
+ /*
+ * 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;
+ }
}
- ckfree((char *) tvarPtr);
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 +1801,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 +1825,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 +1837,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 +1871,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 +1891,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);
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
new file mode 100644
index 0000000..09c3dd0
--- /dev/null
+++ b/generic/tclCompCmds.c
@@ -0,0 +1,1980 @@
+/*
+ * 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: tclCompCmds.c,v 1.2 1999/04/16 00:46:43 stanton Exp $
+ */
+
+#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);
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ /*
+ * A simple variable name. Divide it up into "name" and "elName"
+ * strings. If it is not a local variable, look it up at runtime.
+ */
+
+ 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;
+ 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);
+ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
+ 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 ((varTokenPtr->numComponents == 4)
+ && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
+ && (varTokenPtr[1].start[varTokenPtr[1].size-1] == '(')
+ && (varTokenPtr[4].type == TCL_TOKEN_TEXT)
+ && (varTokenPtr[4].size == 1)
+ && (varTokenPtr[4].start[0] == ')')) {
+ simpleVarName = 1;
+ name = varTokenPtr[1].start;
+ nameChars = varTokenPtr[1].size - 1;
+ elName = varTokenPtr[2].start;
+ elNameChars = varTokenPtr[2].size;
+ }
+
+ 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/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 21be023..42342b1 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -3,12 +3,12 @@
*
* 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.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.2 1998/09/14 18:39:58 stanton Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.3 1999/04/16 00:46:44 stanton Exp $
*/
#include "tclInt.h"
@@ -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;
- }
- 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;
+ Tcl_MutexLock(&opMutex);
+ if (opTableInitialized) {
+ Tcl_DeleteHashTable(&opHashTable);
+ opTableInitialized = 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,302 @@ 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;
+ char savedChar;
+ 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.
- *
- *----------------------------------------------------------------------
- */
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+ break;
+
+ case TCL_TOKEN_SUB_EXPR:
+ infoPtr->exprIsComparison = 0;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
+ break;
+
+ case TCL_TOKEN_OPERATOR:
+ /*
+ * Look up the operator. Temporarily overwrite the character
+ * just after the end of the operator with a 0 byte. If the
+ * operator isn't found, treat it as a math function.
+ */
-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 */
- }
+ /*
+ * TODO: Note that the string is modified in place. This is unsafe
+ * and will break if any of the routines called while the string is
+ * modified have side effects that depend on the original string
+ * being unmodified (e.g. adding an entry to the literal table).
+ */
- 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;
- }
+ operator = tokenPtr->start;
+ savedChar = operator[tokenPtr->size];
+ operator[tokenPtr->size] = 0;
+ hPtr = Tcl_FindHashEntry(&opHashTable, operator);
+ if (hPtr == NULL) {
+ code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
+ envPtr, &endPtr);
+ operator[tokenPtr->size] = (char) savedChar;
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr = endPtr;
+ infoPtr->exprIsJustVarRef = 0;
+ infoPtr->exprIsComparison = 0;
+ break;
+ }
+ operator[tokenPtr->size] = (char) savedChar;
+ opIndex = (int) Tcl_GetHashValue(hPtr);
+ opDescPtr = &(operatorTable[opIndex]);
- 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.
+ * If the operator is "normal", compile it using information
+ * from the operator table.
*/
- 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;
-
- TclEmitPush(objIndex, envPtr);
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
+ if (opDescPtr->numOperands > 0) {
+ tokenPtr++;
+ code = CompileSubExpr(tokenPtr, infoPtr, envPtr);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ maxDepth = envPtr->maxStackDepth;
+ tokenPtr += (tokenPtr->numComponents + 1);
- jumpDist = (TclCurrCodeOffset() - jumpTrueFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpTrueFixup, jumpDist, 127)) {
- panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
+ 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;
}
- objIndex = TclObjIndexForString("1", 1, /*allocStrRep*/ 0,
- /*inHeap*/ 0, envPtr);
- objPtr = envPtr->objArrayPtr[objIndex];
-
- Tcl_InvalidateStringRep(objPtr);
- objPtr->internalRep.longValue = 1;
- objPtr->typePtr = &tclIntType;
- TclEmitPush(objIndex, envPtr);
-
- jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
- if (TclFixupForwardJump(envPtr, &jumpFixup, jumpDist, 127)) {
- panic("CompileLandExpr: bad jump distance %d\n", jumpDist);
- }
- }
-
- /*
- * 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 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 (jumpFixupArray.next == jumpFixupArray.end) {
- TclExpandJumpFixupArray(&jumpFixupArray);
- }
- fixupIndex = jumpFixupArray.next;
- jumpFixupArray.next++;
- TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- &(jumpFixupArray.fixup[fixupIndex]));
-
- /*
- * Compile the subexpression.
- */
-
- result = CompileBitOrExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
- goto done;
- }
- maxDepth = TclMax((envPtr->maxStackDepth + 1), maxDepth);
+ /*
+ * 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;
- /*
- * 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.
- */
+ 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;
- 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 +661,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;
-
- 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.
- *
- *----------------------------------------------------------------------
- */
+ 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;
-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);
+ tokenPtr += (tokenPtr->numComponents + 1);
- /*
- * A comparison is not the top-level operator in this expression.
- */
-
- 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;
-
- /*
- * A comparison _is_ the top-level operator in this expression.
- */
-
- infoPtr->exprIsComparison = 1;
- }
+ /*
+ * 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.
+ */
- 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.
- *
- *----------------------------------------------------------------------
- */
+ TclEmitOpcode(INST_DUP, envPtr);
+ TclEmitForwardJump(envPtr,
+ ((opIndex==OP_LAND)? TCL_FALSE_JUMP : TCL_TRUE_JUMP),
+ &shortCircuitFixup);
-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 +783,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;
- HERE("shiftExpr", 9);
- result = CompileAddExpr(interp, infoPtr, flags, envPtr);
- if (result != TCL_OK) {
+ /*
+ * Emit code for the test.
+ */
+
+ 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 +898,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 +914,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 +951,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;
-
- 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.
- */
+ int numBytes = (infoPtr->lastChar - infoPtr->expr);
+ char buffer[100];
- 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/generic/tclCompile.c b/generic/tclCompile.c
index 15a30a7..12b6cd4 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -5,19 +5,27 @@
* of commands (like quoted strings or nested sub-commands) into a
* sequence of instructions ("bytecodes").
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * 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: tclCompile.c,v 1.13 1999/02/03 00:55:04 stanton Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.14 1999/04/16 00:46:44 stanton Exp $
*/
#include "tclInt.h"
#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
@@ -30,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
@@ -216,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. */
@@ -229,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
@@ -421,481 +247,151 @@ 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 --
+ * SetByteCodeFromAny --
*
- * 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.
*
* 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. */
+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. */
{
- 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);
+ if (result != TCL_OK) {
+ /*
+ * Compilation errors.
+ */
- /*
- * 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 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;
- }
+ 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*/
- /*
- * Print the ExceptionRange array.
- */
-
- 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);
+ auxDataPtr = compEnv.auxDataArrayPtr;
+ for (i = 0; i < compEnv.auxDataArrayNext; i++) {
+ if (auxDataPtr->type->freeProc != NULL) {
+ auxDataPtr->type->freeProc(auxDataPtr->clientData);
}
+ auxDataPtr++;
}
+ goto done;
}
-
- /*
- * 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.
+ * Successful compilation. Add a "done" instruction at the end.
*/
- 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;
+ compEnv.numSrcBytes = iPtr->termOffset;
+ TclEmitOpcode(INST_DONE, &compEnv);
- 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, 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");
- }
-
/*
- * 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.
+ * Change the object into a ByteCode object. Ownership of the literal
+ * objects and aux data items is given to the ByteCode object.
*/
-
- 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, 70));
- fprintf(stdout, "\n");
+
+#ifdef TCL_COMPILE_DEBUG
+ TclVerifyLocalLiteralTable(&compEnv);
+#endif /*TCL_COMPILE_DEBUG*/
+ TclInitByteCodeObj(objPtr, &compEnv);
+#ifdef TCL_COMPILE_DEBUG
+ if (tclTraceCompile == 2) {
+ TclPrintByteCodeObj(interp, objPtr);
}
- if (pc < codeLimit) {
- /*
- * Print instructions after the last command.
- */
+#endif /* TCL_COMPILE_DEBUG */
- while (pc < codeLimit) {
- fprintf(stdout, " ");
- pc += TclPrintInstruction(codePtr, pc);
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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, elemLen, i, j;
- Tcl_Obj *elemPtr;
- char *string;
+ /*
+ * Free storage allocated during compilation.
+ */
- 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;
- }
+ done:
+ if (localTablePtr->buckets != localTablePtr->staticBuckets) {
+ ckfree((char *) localTablePtr->buckets);
}
- fprintf(stdout, "\n");
- return instDesc->numBytes;
+ TclFreeCompileEnv(&compEnv);
+ return result;
}
/*
*----------------------------------------------------------------------
*
- * 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;
}
/*
@@ -947,202 +443,100 @@ 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.
*/
- 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);
- }
- 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) {
+ if (interp != NULL) {
/*
- * Add a "done" instruction at the end of the instruction sequence.
+ * 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.
*/
-
- TclEmitOpcode(INST_DONE, &compEnv);
-
- /*
- * Convert the object to a ByteCode object.
- */
-
- 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);
}
/*
@@ -1163,44 +557,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;
@@ -1222,15 +614,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.
*
*----------------------------------------------------------------------
*/
@@ -1239,15 +630,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);
@@ -1260,5324 +650,1076 @@ 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 */
+ 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, /*alreadyAlloced*/ 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, /*alreadyAlloced*/ 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;
- }
-
- /*
- * 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);
- }
+ int code;
/*
- *==== At this point we believe we can compile the catch command ====
+ * Handle the common case: if there is a single text token, compile it
+ * into an inline sequence of instructions.
*/
-
- /*
- * Create and initialize a ExceptionRange record to hold information
- * about this catch command.
- */
-
- 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, *partPtr;
+ JumpFixup jumpFixup;
+ int maxDepth, doExprInline, range, numBytes, i, j, code;
+ char *script;
+ char saveChar;
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;
- }
+ envPtr->maxStackDepth = 0;
+ maxDepth = 0;
+ range = -1;
+ code = TCL_OK;
/*
- * 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 the expression is a single word that doesn't require
+ * substitutions, just compile it's string into inline instructions.
*/
- 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.
- */
+ if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
+ /*
+ * Temporarily overwrite the character just after the end of the
+ * string with a 0 byte.
+ */
- *wordEnd = '\0';
- result = TclCompileExpr(interp, (wordStart + 1), wordEnd,
- flags, envPtr);
- *wordEnd = '}';
-
- envPtr->termOffset = (wordEnd + 1) - string;
- envPtr->pushSimpleWords = savePushSimpleWords;
- FreeArgInfo(&argInfo);
- return result;
- }
+ script = tokenPtr[1].start;
+ numBytes = tokenPtr[1].size;
+ saveChar = script[numBytes];
+ script[numBytes] = 0;
+ code = TclCompileExpr(interp, script, numBytes, envPtr);
+ script[numBytes] = saveChar;
+ return code;
}
/*
- * 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));
+ * Multiple words or the single word requires substitutions. We may
+ * need to call expr's command proc at runtime. This often recompiles
+ * the expression each time and is slow. However, there are some
+ * circumstances where we can still compile inline code "optimistically"
+ * and check for type errors during execution that signal when double
+ * substitutions must be done.
+ */
+
+ doExprInline = 1;
+ wordPtr = tokenPtr;
+ for (i = 0; ((i < numWords) && doExprInline); i++) {
+ if (wordPtr->type == TCL_TOKEN_WORD) {
+ for (j = 0, partPtr = wordPtr+1; j < wordPtr->numComponents;
+ j++, partPtr++) {
+ if ((partPtr->type == TCL_TOKEN_BS)
+ || (partPtr->type == TCL_TOKEN_COMMAND)) {
+ doExprInline = 0;
+ break;
+ }
+ }
}
+ wordPtr += (wordPtr->numComponents + 1);
}
/*
- * Scan the concatenated expression's characters looking for any
- * '['s or '\'s or '$'s. If any are found, just call the expr cmd
- * at runtime.
+ * If only variable substitutions appear (no backslash or command
+ * substitutions), inline compile the expr inside a "catch" so that if
+ * there is any error, we call expr's command proc at runtime.
*/
- inlineCode = 1;
- first = Tcl_DStringValue(&buffer);
- last = first + (Tcl_DStringLength(&buffer) - 1);
- for (p = first; p <= last; p++) {
- c = *p;
- if ((c == '[') || (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.
- */
-
+ if (doExprInline) {
+ Tcl_DString exprBuffer;
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 concatenated expression.
- */
-
- envPtr->excRangeArrayPtr[range].codeOffset = TclCurrCodeOffset();
- savedChar = *(last + 1);
- *(last + 1) = '\0';
- result = TclCompileExpr(interp, first, last + 1, flags, envPtr);
- *(last + 1) = savedChar;
+ int startExceptNext = envPtr->exceptArrayNext;
+ envPtr->exceptDepth++;
+ envPtr->maxExceptDepth =
+ TclMax(envPtr->exceptDepth, envPtr->maxExceptDepth);
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
+
+ Tcl_DStringInit(&exprBuffer);
+ wordPtr = tokenPtr;
+ for (i = 0; i < numWords; i++) {
+ if (i > 0) {
+ Tcl_DStringAppend(&exprBuffer, " ", 1);
+ }
+ for (j = 0, partPtr = wordPtr+1; j < wordPtr->numComponents;
+ j++, partPtr++) {
+ switch (partPtr->type) {
+ case TCL_TOKEN_TEXT:
+ Tcl_DStringAppend(&exprBuffer, partPtr->start,
+ partPtr->size);
+ break;
+
+ case TCL_TOKEN_VARIABLE:
+ Tcl_DStringAppend(&exprBuffer, partPtr->start,
+ partPtr->size);
+ j += partPtr->numComponents;
+ partPtr += partPtr->numComponents;
+ break;
+
+ default:
+ panic("unexpected token type in TclCompileExprWords");
+ }
+ }
+ wordPtr += (wordPtr->numComponents + 1);
+ }
+ envPtr->exceptArrayPtr[range].codeOffset =
+ (envPtr->codeNext - envPtr->codeStart);
+ code = TclCompileExpr(interp, Tcl_DStringValue(&exprBuffer),
+ Tcl_DStringLength(&exprBuffer), envPtr);
+ envPtr->exceptArrayPtr[range].numCodeBytes =
+ (envPtr->codeNext - envPtr->codeStart)
+ - envPtr->exceptArrayPtr[range].codeOffset;
maxDepth = envPtr->maxStackDepth;
- envPtr->excRangeArrayPtr[range].numCodeBytes =
- TclCurrCodeOffset() - envPtr->excRangeArrayPtr[range].codeOffset;
+ Tcl_DStringFree(&exprBuffer);
- if ((result != TCL_OK) || (envPtr->exprIsJustVarRef)
+ if ((code != 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.
+ * Delete the inline code and call the expr command proc at
+ * runtime. There was a compilation error or the inline code
+ * might not have the right 2 level substitution semantics:
+ * e.g., if the expr consisted of a single variable ref or the
+ * top-level operator is a comparison (which might operate on
+ * strings). The code might appear to execute successfully but
+ * produce the wrong result. We depend on execution failing if a
+ * second level of substitutions is required.
*/
envPtr->codeNext = (envPtr->codeStart + startCodeOffset);
- envPtr->excRangeArrayNext = startRangeNext;
- inlineCode = 0;
+ envPtr->exceptArrayNext = startExceptNext;
+ doExprInline = 0;
} else {
TclEmitOpcode(INST_END_CATCH, envPtr); /* for ok case */
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
+ envPtr->exceptArrayPtr[range].catchOffset =
+ (envPtr->codeNext - envPtr->codeStart);
TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
}
}
/*
- * 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 generating inline code, update the target of the jump at the end.
*/
- if (inlineCode) {
- int jumpDist = (TclCurrCodeOffset() - jumpFixup.codeOffset);
+ if (doExprInline) {
+ int jumpDist = (envPtr->codeNext - envPtr->codeStart)
+ - 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;
+ envPtr->exceptArrayPtr[range].catchOffset += 3;
}
+ envPtr->exceptDepth--;
}
- 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.
+ * Compute the total number of bytes needed for this bytecode.
*/
- 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.
- */
-
- 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);
- }
-
- /*
- * 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;
+ codePtr->exceptArrayPtr = NULL;
}
- 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;
- }
- 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;
- }
+ codePtr->auxDataArrayPtr = NULL;
}
- /*
- * 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.
- */
-
- 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.
+ * Record various compilation-related statistics about the new ByteCode
+ * structure. Don't include overhead for statistics-related fields.
*/
- 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 (length < 0) {
+ length = strlen(command);
}
-
- /*
- * 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); /* for ok case */
- TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
- envPtr->excRangeArrayPtr[range].catchOffset = TclCurrCodeOffset();
- TclEmitOpcode(INST_END_CATCH, envPtr); /* for error case */
- }
- }
-
- /*
- * 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 > 150) {
+ length = 150;
+ ellipsis = "...";
}
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- envPtr->exprIsJustVarRef = saveExprIsJustVarRef;
- envPtr->exprIsComparison = saveExprIsComparison;
- return result;
+ sprintf(buffer, "\n while compiling\n\"%.*s%s\"",
+ length, command, ellipsis);
+ Tcl_AddObjErrorInfo(interp, buffer, -1);
}
/*
*----------------------------------------------------------------------
*
- * 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;
- }
- }
-
- done:
- envPtr->termOffset = (src - string);
- envPtr->maxStackDepth = maxDepth;
- envPtr->pushSimpleWords = savePushSimpleWords;
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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
@@ -6586,39 +1728,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
@@ -6626,14 +1766,14 @@ 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)) {
+ && (nameBytes == localPtr->nameLength)
+ && (strncmp(name, localName, (unsigned) nameBytes) == 0)) {
return i;
}
}
@@ -6645,11 +1785,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 {
@@ -6657,22 +1797,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;
}
/*
@@ -6760,7 +1901,7 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
if (resVarInfo && resVarInfo->fetchProc) {
resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
- resVarInfo);
+ resVarInfo);
}
if (resolvedVarPtr) {
@@ -6791,277 +1932,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
@@ -7090,7 +1960,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);
@@ -7112,57 +1982,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
@@ -7225,14 +2044,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;
}
@@ -7258,248 +2077,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.
@@ -7507,37 +2116,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);
@@ -7548,20 +2152,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;
@@ -7596,10 +2200,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;
@@ -7635,8 +2239,8 @@ TclCreateAuxData(clientData, typePtr, envPtr)
envPtr->auxDataArrayNext++;
auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
- auxDataPtr->type = typePtr;
auxDataPtr->clientData = clientData;
+ auxDataPtr->type = typePtr;
return index;
}
@@ -7783,24 +2387,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;
}
}
@@ -7865,9 +2469,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--) {
@@ -7900,10 +2509,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) {
@@ -7917,7 +2526,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 */
@@ -7933,8 +2543,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.
@@ -7976,6 +2586,7 @@ TclRegisterAuxDataType(typePtr)
register Tcl_HashEntry *hPtr;
int new;
+ Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
TclInitAuxDataTypeTable();
}
@@ -7997,6 +2608,7 @@ TclRegisterAuxDataType(typePtr)
if (new) {
Tcl_SetHashValue(hPtr, typePtr);
}
+ Tcl_MutexUnlock(&tableMutex);
}
/*
@@ -8023,6 +2635,7 @@ TclGetAuxDataType(typeName)
register Tcl_HashEntry *hPtr;
AuxDataType *typePtr = NULL;
+ Tcl_MutexLock(&tableMutex);
if (!auxDataTypeTableInitialized) {
TclInitAuxDataTypeTable();
}
@@ -8031,6 +2644,7 @@ TclGetAuxDataType(typeName)
if (hPtr != (Tcl_HashEntry *) NULL) {
typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
}
+ Tcl_MutexUnlock(&tableMutex);
return typePtr;
}
@@ -8057,9 +2671,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);
}
@@ -8070,13 +2692,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.
*
*----------------------------------------------------------------------
*/
@@ -8084,8 +2707,746 @@ 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/generic/tclCompile.h b/generic/tclCompile.h
index 44eac12..4a718fd 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1,12 +1,12 @@
/*
* 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.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.9 1999/03/10 05:52:47 stanton Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.10 1999/04/16 00:46:45 stanton Exp $
*/
#ifndef _TCLCOMPILATION
@@ -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,17 +120,69 @@ 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;
/*
+ * CompileProcs need the ability to record information during compilation
+ * that can be used by bytecode instructions during execution. The AuxData
+ * structure provides this "auxiliary data" mechanism. An arbitrary number
+ * of these structures can be stored in the ByteCode record (during
+ * compilation they are stored in a CompileEnv structure). Each AuxData
+ * record holds one word of client-specified data (often a pointer) and is
+ * given an index that instructions can later use to look up the structure
+ * and its data.
+ *
+ * The following definitions declare the types of procedures that are called
+ * to duplicate or free this auxiliary data when the containing ByteCode
+ * objects are duplicated and freed. Pointers to these procedures are kept
+ * in the AuxData structure.
+ */
+
+typedef ClientData (AuxDataDupProc) _ANSI_ARGS_((ClientData clientData));
+typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * We define a separate AuxDataType struct to hold type-related information
+ * for the AuxData structure. This separation makes it possible for clients
+ * outside of the TCL core to manipulate (in a limited fashion!) AuxData;
+ * for example, it makes it possible to pickle and unpickle AuxData structs.
+ */
+
+typedef struct AuxDataType {
+ char *name; /* the name of the type. Types can be
+ * registered and found by name */
+ AuxDataDupProc *dupProc; /* Callback procedure to invoke when the
+ * aux data is duplicated (e.g., when the
+ * ByteCode structure containing the aux
+ * data is duplicated). NULL means just
+ * copy the source clientData bits; no
+ * proc need be called. */
+ AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the
+ * aux data is freed. NULL means no
+ * proc need be called. */
+} AuxDataType;
+
+/*
+ * The definition of the AuxData structure that holds information created
+ * during compilation by CompileProcs and used by instructions during
+ * execution.
+ */
+
+typedef struct AuxData {
+ AuxDataType *type; /* pointer to the AuxData type associated with
+ * this ClientData. */
+ ClientData clientData; /* The compilation data itself. */
+} AuxData;
+
+/*
* Structure defining the compilation environment. After compilation, fields
* describing bytecode instructions are copied out into the more compact
* ByteCode structure defined below.
*/
#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
@@ -173,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
@@ -215,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
@@ -258,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. */
@@ -272,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.
*/
/*
@@ -283,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
@@ -315,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. */
@@ -378,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
@@ -542,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
@@ -566,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
@@ -617,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
@@ -664,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
@@ -677,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
@@ -720,24 +715,32 @@ 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));
@@ -745,10 +748,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));
@@ -758,21 +766,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
/*
*----------------------------------------------------------------
@@ -782,23 +811,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:
*
@@ -807,55 +819,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); \
@@ -866,12 +868,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
@@ -883,9 +879,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)); \
}
/*
@@ -979,22 +975,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/generic/tclDate.c b/generic/tclDate.c
index eb87b76..cdbcfe8 100644
--- a/generic/tclDate.c
+++ b/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: tclDate.c,v 1.3 1999/03/10 05:52:47 stanton Exp $
+ * RCS: @(#) $Id: tclDate.c,v 1.4 1999/04/16 00:46:45 stanton Exp $
*/
#include "tclInt.h"
@@ -537,11 +537,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 +611,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;
@@ -660,10 +658,10 @@ TclDatelex()
TclDateInput++;
}
- if (isdigit(c = *TclDateInput) || c == '-' || c == '+') {
+ if (isdigit(c = *TclDateInput) || c == '-' || c == '+') { /* INTL: digit */
if (c == '-' || c == '+') {
sign = c == '-' ? -1 : 1;
- if (!isdigit(*++TclDateInput)) {
+ if (!isdigit(*++TclDateInput)) { /* INTL: digit */
/*
* skip the '-' sign
*/
@@ -672,7 +670,8 @@ TclDatelex()
} else {
sign = 0;
}
- for (TclDatelval.Number = 0; isdigit(c = *TclDateInput++); ) {
+ for (TclDatelval.Number = 0;
+ isdigit(c = *TclDateInput++); ) { /* INTL: digit */
TclDatelval.Number = 10 * TclDatelval.Number + c - '0';
}
TclDateInput--;
@@ -681,8 +680,9 @@ TclDatelex()
}
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(c = *TclDateInput++) /* INTL: ISO only. */
+ || c == '.'; ) {
if (p < &buff[sizeof buff - 1]) {
*p++ = c;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 70bdf2a..f07ff56 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDecls.h,v 1.6 1999/03/11 02:49:34 stanton Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.7 1999/04/16 00:46:45 stanton Exp $
*/
#ifndef _TCLDECLS
@@ -35,7 +35,7 @@ EXTERN char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp,
char * name, char * version, int exact,
ClientData * clientDataPtr));
/* 2 */
-EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
/* 3 */
EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size));
/* 4 */
@@ -109,7 +109,7 @@ EXTERN Tcl_Obj * Tcl_DbNewLongObj _ANSI_ARGS_((long longValue,
/* 27 */
EXTERN Tcl_Obj * Tcl_DbNewObj _ANSI_ARGS_((char * file, int line));
/* 28 */
-EXTERN Tcl_Obj * Tcl_DbNewStringObj _ANSI_ARGS_((char * bytes,
+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));
@@ -117,7 +117,7 @@ EXTERN Tcl_Obj * Tcl_DuplicateObj _ANSI_ARGS_((Tcl_Obj * objPtr));
EXTERN void TclFreeObj _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 31 */
EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int * boolPtr));
+ char * str, int * boolPtr));
/* 32 */
EXTERN int Tcl_GetBooleanFromObj _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * objPtr,
@@ -127,7 +127,7 @@ EXTERN unsigned char * Tcl_GetByteArrayFromObj _ANSI_ARGS_((
Tcl_Obj * objPtr, int * lengthPtr));
/* 34 */
EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, double * doublePtr));
+ char * str, double * doublePtr));
/* 35 */
EXTERN int Tcl_GetDoubleFromObj _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Obj * objPtr,
@@ -138,7 +138,7 @@ EXTERN int Tcl_GetIndexFromObj _ANSI_ARGS_((Tcl_Interp * interp,
char * msg, int flags, int * indexPtr));
/* 37 */
EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int * intPtr));
+ char * str, int * intPtr));
/* 38 */
EXTERN int Tcl_GetIntFromObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, int * intPtr));
@@ -193,7 +193,7 @@ 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_((char * bytes,
+EXTERN Tcl_Obj * Tcl_NewStringObj _ANSI_ARGS_((CONST char * bytes,
int length));
/* 57 */
EXTERN void Tcl_SetBooleanObj _ANSI_ARGS_((Tcl_Obj * objPtr,
@@ -224,15 +224,15 @@ EXTERN void Tcl_SetStringObj _ANSI_ARGS_((Tcl_Obj * objPtr,
char * bytes, int length));
/* 66 */
EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * message));
+ CONST char * message));
/* 67 */
EXTERN void Tcl_AddObjErrorInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * message, int length));
+ 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,
- char * string));
+ CONST char * string));
/* 70 */
EXTERN void Tcl_AppendResult _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
/* 71 */
@@ -391,7 +391,7 @@ EXTERN void Tcl_DoWhenIdle _ANSI_ARGS_((Tcl_IdleProc * proc,
ClientData clientData));
/* 117 */
EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString * dsPtr,
- CONST char * string, int length));
+ CONST char * str, int length));
/* 118 */
EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_((
Tcl_DString * dsPtr, CONST char * string));
@@ -440,19 +440,19 @@ EXTERN int Tcl_ExposeCommand _ANSI_ARGS_((Tcl_Interp * interp,
char * hiddenCmdToken, char * cmdName));
/* 135 */
EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int * ptr));
+ 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 * string, double * ptr));
+ 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 * string, long * ptr));
+ char * str, long * ptr));
/* 140 */
EXTERN int Tcl_ExprLongObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr, long * ptr));
@@ -465,7 +465,7 @@ EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp,
/* 143 */
EXTERN void Tcl_Finalize _ANSI_ARGS_((void));
/* 144 */
-EXTERN void Tcl_FindExecutable _ANSI_ARGS_((char * argv0));
+EXTERN void Tcl_FindExecutable _ANSI_ARGS_((CONST char * argv0));
/* 145 */
EXTERN Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_((
Tcl_HashTable * tablePtr,
@@ -534,7 +534,7 @@ 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 * string, int write, int checkUsage,
+ char * str, int write, int checkUsage,
ClientData * filePtr));
#endif /* UNIX */
/* 168 */
@@ -665,11 +665,11 @@ 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, char * string,
- char * start));
+ Tcl_RegExp regexp, CONST char * str,
+ CONST char * start));
/* 214 */
EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, char * pattern));
+ char * str, char * pattern));
/* 215 */
EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
int index, char ** startPtr, char ** endPtr));
@@ -678,12 +678,11 @@ 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 * string,
+EXTERN int Tcl_ScanElement _ANSI_ARGS_((CONST char * str,
int * flagPtr));
/* 219 */
-EXTERN int Tcl_ScanCountedElement _ANSI_ARGS_((
- CONST char * string, int length,
- int * flagPtr));
+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));
@@ -719,7 +718,7 @@ EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_((
Tcl_Interp * interp, int depth));
/* 232 */
EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, Tcl_FreeProc * freeProc));
+ char * str, Tcl_FreeProc * freeProc));
/* 233 */
EXTERN int Tcl_SetServiceMode _ANSI_ARGS_((int mode));
/* 234 */
@@ -746,9 +745,10 @@ EXTERN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp));
/* 242 */
EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp * interp,
- char * list, int * argcPtr, char *** argvPtr));
+ CONST char * listStr, int * argcPtr,
+ char *** argvPtr));
/* 243 */
-EXTERN void Tcl_SplitPath _ANSI_ARGS_((char * path,
+EXTERN void Tcl_SplitPath _ANSI_ARGS_((CONST char * path,
int * argcPtr, char *** argvPtr));
/* 244 */
EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp,
@@ -756,8 +756,8 @@ EXTERN void Tcl_StaticPackage _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_PackageInitProc * initProc,
Tcl_PackageInitProc * safeInitProc));
/* 245 */
-EXTERN int Tcl_StringMatch _ANSI_ARGS_((char * string,
- char * pattern));
+EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str,
+ CONST char * pattern));
/* 246 */
EXTERN int Tcl_Tell _ANSI_ARGS_((Tcl_Channel chan));
/* 247 */
@@ -844,7 +844,7 @@ EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_((
EXTERN char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr));
/* 270 */
EXTERN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, char ** termPtr));
+ char * str, char ** termPtr));
/* 271 */
EXTERN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
char * name, char * version, int exact));
@@ -868,10 +868,256 @@ EXTERN int Tcl_VarEvalVA _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr,
int options));
/* 278 */
-EXTERN void panicVA _ANSI_ARGS_((char * format, va_list argList));
+EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
+ va_list argList));
/* 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));
+/* Slot 281 is reserved */
+/* Slot 282 is reserved */
+/* Slot 283 is reserved */
+/* 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, size_t 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));
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -885,7 +1131,7 @@ typedef struct TclStubs {
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 (*panic) _ANSI_ARGS_(TCL_VARARGS(char *,format)); /* 2 */
+ 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 */
@@ -927,16 +1173,16 @@ typedef struct TclStubs {
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_((char * bytes, int length, char * file, int line)); /* 28 */
+ 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 * string, int * boolPtr)); /* 31 */
+ 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 * string, double * doublePtr)); /* 34 */
+ 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 * string, int * intPtr)); /* 37 */
+ 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 */
@@ -955,7 +1201,7 @@ typedef struct TclStubs {
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_((char * bytes, int length)); /* 56 */
+ 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 */
@@ -965,10 +1211,10 @@ typedef struct TclStubs {
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, char * message)); /* 66 */
- void (*tcl_AddObjErrorInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * message, int length)); /* 67 */
+ 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, char * string)); /* 69 */
+ 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 */
@@ -1016,7 +1262,7 @@ typedef struct TclStubs {
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 * string, int length)); /* 117 */
+ 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 */
@@ -1034,16 +1280,16 @@ typedef struct TclStubs {
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 * string, int * ptr)); /* 135 */
+ 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 * string, double * ptr)); /* 137 */
+ 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 * string, long * ptr)); /* 139 */
+ 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_((char * argv0)); /* 144 */
+ 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 */
@@ -1067,7 +1313,7 @@ typedef struct TclStubs {
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 * string, int write, int checkUsage, ClientData * filePtr)); /* 167 */
+ int (*tcl_GetOpenFile) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int write, int checkUsage, ClientData * filePtr)); /* 167 */
#endif /* UNIX */
#ifdef __WIN32__
void *reserved167;
@@ -1120,13 +1366,13 @@ typedef struct TclStubs {
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, char * string, char * start)); /* 213 */
- int (*tcl_RegExpMatch) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * pattern)); /* 214 */
+ 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 * string, int * flagPtr)); /* 218 */
- int (*tcl_ScanCountedElement) _ANSI_ARGS_((CONST char * string, int length, int * flagPtr)); /* 219 */
+ 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 */
@@ -1139,7 +1385,7 @@ typedef struct TclStubs {
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 * string, Tcl_FreeProc * freeProc)); /* 232 */
+ 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 */
@@ -1149,10 +1395,10 @@ typedef struct TclStubs {
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, char * list, int * argcPtr, char *** argvPtr)); /* 242 */
- void (*tcl_SplitPath) _ANSI_ARGS_((char * path, int * argcPtr, char *** argvPtr)); /* 243 */
+ 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_((char * string, char * pattern)); /* 245 */
+ 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 */
@@ -1177,7 +1423,7 @@ typedef struct TclStubs {
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 * string, char ** termPtr)); /* 270 */
+ 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 */
@@ -1185,8 +1431,95 @@ typedef struct TclStubs {
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 */
- void (*panicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
+ void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */
+ void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */
+ void *reserved281;
+ void *reserved282;
+ void *reserved283;
+ 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, size_t 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 */
} TclStubs;
extern TclStubs *tclStubsPtr;
@@ -1198,1127 +1531,1460 @@ extern TclStubs *tclStubsPtr;
*/
#ifndef Tcl_PkgProvideEx
-#define Tcl_PkgProvideEx(interp, name, version, clientData) \
- (tclStubsPtr->tcl_PkgProvideEx)(interp, name, version, clientData) /* 0 */
+#define Tcl_PkgProvideEx \
+ (tclStubsPtr->tcl_PkgProvideEx) /* 0 */
#endif
#ifndef Tcl_PkgRequireEx
-#define Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr) \
- (tclStubsPtr->tcl_PkgRequireEx)(interp, name, version, exact, clientDataPtr) /* 1 */
+#define Tcl_PkgRequireEx \
+ (tclStubsPtr->tcl_PkgRequireEx) /* 1 */
#endif
-#ifndef panic
-#define panic \
- (tclStubsPtr->panic) /* 2 */
+#ifndef Tcl_Panic
+#define Tcl_Panic \
+ (tclStubsPtr->tcl_Panic) /* 2 */
#endif
#ifndef Tcl_Alloc
-#define Tcl_Alloc(size) \
- (tclStubsPtr->tcl_Alloc)(size) /* 3 */
+#define Tcl_Alloc \
+ (tclStubsPtr->tcl_Alloc) /* 3 */
#endif
#ifndef Tcl_Free
-#define Tcl_Free(ptr) \
- (tclStubsPtr->tcl_Free)(ptr) /* 4 */
+#define Tcl_Free \
+ (tclStubsPtr->tcl_Free) /* 4 */
#endif
#ifndef Tcl_Realloc
-#define Tcl_Realloc(ptr, size) \
- (tclStubsPtr->tcl_Realloc)(ptr, size) /* 5 */
+#define Tcl_Realloc \
+ (tclStubsPtr->tcl_Realloc) /* 5 */
#endif
#ifndef Tcl_DbCkalloc
-#define Tcl_DbCkalloc(size, file, line) \
- (tclStubsPtr->tcl_DbCkalloc)(size, file, line) /* 6 */
+#define Tcl_DbCkalloc \
+ (tclStubsPtr->tcl_DbCkalloc) /* 6 */
#endif
#ifndef Tcl_DbCkfree
-#define Tcl_DbCkfree(ptr, file, line) \
- (tclStubsPtr->tcl_DbCkfree)(ptr, file, line) /* 7 */
+#define Tcl_DbCkfree \
+ (tclStubsPtr->tcl_DbCkfree) /* 7 */
#endif
#ifndef Tcl_DbCkrealloc
-#define Tcl_DbCkrealloc(ptr, size, file, line) \
- (tclStubsPtr->tcl_DbCkrealloc)(ptr, size, file, line) /* 8 */
+#define Tcl_DbCkrealloc \
+ (tclStubsPtr->tcl_DbCkrealloc) /* 8 */
#endif
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef Tcl_CreateFileHandler
-#define Tcl_CreateFileHandler(fd, mask, proc, clientData) \
- (tclStubsPtr->tcl_CreateFileHandler)(fd, mask, proc, clientData) /* 9 */
+#define Tcl_CreateFileHandler \
+ (tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif
#endif /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef Tcl_DeleteFileHandler
-#define Tcl_DeleteFileHandler(fd) \
- (tclStubsPtr->tcl_DeleteFileHandler)(fd) /* 10 */
+#define Tcl_DeleteFileHandler \
+ (tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif
#endif /* UNIX */
#ifndef Tcl_SetTimer
-#define Tcl_SetTimer(timePtr) \
- (tclStubsPtr->tcl_SetTimer)(timePtr) /* 11 */
+#define Tcl_SetTimer \
+ (tclStubsPtr->tcl_SetTimer) /* 11 */
#endif
#ifndef Tcl_Sleep
-#define Tcl_Sleep(ms) \
- (tclStubsPtr->tcl_Sleep)(ms) /* 12 */
+#define Tcl_Sleep \
+ (tclStubsPtr->tcl_Sleep) /* 12 */
#endif
#ifndef Tcl_WaitForEvent
-#define Tcl_WaitForEvent(timePtr) \
- (tclStubsPtr->tcl_WaitForEvent)(timePtr) /* 13 */
+#define Tcl_WaitForEvent \
+ (tclStubsPtr->tcl_WaitForEvent) /* 13 */
#endif
#ifndef Tcl_AppendAllObjTypes
-#define Tcl_AppendAllObjTypes(interp, objPtr) \
- (tclStubsPtr->tcl_AppendAllObjTypes)(interp, objPtr) /* 14 */
+#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(objPtr, bytes, length) \
- (tclStubsPtr->tcl_AppendToObj)(objPtr, bytes, length) /* 16 */
+#define Tcl_AppendToObj \
+ (tclStubsPtr->tcl_AppendToObj) /* 16 */
#endif
#ifndef Tcl_ConcatObj
-#define Tcl_ConcatObj(objc, objv) \
- (tclStubsPtr->tcl_ConcatObj)(objc, objv) /* 17 */
+#define Tcl_ConcatObj \
+ (tclStubsPtr->tcl_ConcatObj) /* 17 */
#endif
#ifndef Tcl_ConvertToType
-#define Tcl_ConvertToType(interp, objPtr, typePtr) \
- (tclStubsPtr->tcl_ConvertToType)(interp, objPtr, typePtr) /* 18 */
+#define Tcl_ConvertToType \
+ (tclStubsPtr->tcl_ConvertToType) /* 18 */
#endif
#ifndef Tcl_DbDecrRefCount
-#define Tcl_DbDecrRefCount(objPtr, file, line) \
- (tclStubsPtr->tcl_DbDecrRefCount)(objPtr, file, line) /* 19 */
+#define Tcl_DbDecrRefCount \
+ (tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
#endif
#ifndef Tcl_DbIncrRefCount
-#define Tcl_DbIncrRefCount(objPtr, file, line) \
- (tclStubsPtr->tcl_DbIncrRefCount)(objPtr, file, line) /* 20 */
+#define Tcl_DbIncrRefCount \
+ (tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#endif
#ifndef Tcl_DbIsShared
-#define Tcl_DbIsShared(objPtr, file, line) \
- (tclStubsPtr->tcl_DbIsShared)(objPtr, file, line) /* 21 */
+#define Tcl_DbIsShared \
+ (tclStubsPtr->tcl_DbIsShared) /* 21 */
#endif
#ifndef Tcl_DbNewBooleanObj
-#define Tcl_DbNewBooleanObj(boolValue, file, line) \
- (tclStubsPtr->tcl_DbNewBooleanObj)(boolValue, file, line) /* 22 */
+#define Tcl_DbNewBooleanObj \
+ (tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
#endif
#ifndef Tcl_DbNewByteArrayObj
-#define Tcl_DbNewByteArrayObj(bytes, length, file, line) \
- (tclStubsPtr->tcl_DbNewByteArrayObj)(bytes, length, file, line) /* 23 */
+#define Tcl_DbNewByteArrayObj \
+ (tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#endif
#ifndef Tcl_DbNewDoubleObj
-#define Tcl_DbNewDoubleObj(doubleValue, file, line) \
- (tclStubsPtr->tcl_DbNewDoubleObj)(doubleValue, file, line) /* 24 */
+#define Tcl_DbNewDoubleObj \
+ (tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
#endif
#ifndef Tcl_DbNewListObj
-#define Tcl_DbNewListObj(objc, objv, file, line) \
- (tclStubsPtr->tcl_DbNewListObj)(objc, objv, file, line) /* 25 */
+#define Tcl_DbNewListObj \
+ (tclStubsPtr->tcl_DbNewListObj) /* 25 */
#endif
#ifndef Tcl_DbNewLongObj
-#define Tcl_DbNewLongObj(longValue, file, line) \
- (tclStubsPtr->tcl_DbNewLongObj)(longValue, file, line) /* 26 */
+#define Tcl_DbNewLongObj \
+ (tclStubsPtr->tcl_DbNewLongObj) /* 26 */
#endif
#ifndef Tcl_DbNewObj
-#define Tcl_DbNewObj(file, line) \
- (tclStubsPtr->tcl_DbNewObj)(file, line) /* 27 */
+#define Tcl_DbNewObj \
+ (tclStubsPtr->tcl_DbNewObj) /* 27 */
#endif
#ifndef Tcl_DbNewStringObj
-#define Tcl_DbNewStringObj(bytes, length, file, line) \
- (tclStubsPtr->tcl_DbNewStringObj)(bytes, length, file, line) /* 28 */
+#define Tcl_DbNewStringObj \
+ (tclStubsPtr->tcl_DbNewStringObj) /* 28 */
#endif
#ifndef Tcl_DuplicateObj
-#define Tcl_DuplicateObj(objPtr) \
- (tclStubsPtr->tcl_DuplicateObj)(objPtr) /* 29 */
+#define Tcl_DuplicateObj \
+ (tclStubsPtr->tcl_DuplicateObj) /* 29 */
#endif
#ifndef TclFreeObj
-#define TclFreeObj(objPtr) \
- (tclStubsPtr->tclFreeObj)(objPtr) /* 30 */
+#define TclFreeObj \
+ (tclStubsPtr->tclFreeObj) /* 30 */
#endif
#ifndef Tcl_GetBoolean
-#define Tcl_GetBoolean(interp, string, boolPtr) \
- (tclStubsPtr->tcl_GetBoolean)(interp, string, boolPtr) /* 31 */
+#define Tcl_GetBoolean \
+ (tclStubsPtr->tcl_GetBoolean) /* 31 */
#endif
#ifndef Tcl_GetBooleanFromObj
-#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
- (tclStubsPtr->tcl_GetBooleanFromObj)(interp, objPtr, boolPtr) /* 32 */
+#define Tcl_GetBooleanFromObj \
+ (tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#endif
#ifndef Tcl_GetByteArrayFromObj
-#define Tcl_GetByteArrayFromObj(objPtr, lengthPtr) \
- (tclStubsPtr->tcl_GetByteArrayFromObj)(objPtr, lengthPtr) /* 33 */
+#define Tcl_GetByteArrayFromObj \
+ (tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
#endif
#ifndef Tcl_GetDouble
-#define Tcl_GetDouble(interp, string, doublePtr) \
- (tclStubsPtr->tcl_GetDouble)(interp, string, doublePtr) /* 34 */
+#define Tcl_GetDouble \
+ (tclStubsPtr->tcl_GetDouble) /* 34 */
#endif
#ifndef Tcl_GetDoubleFromObj
-#define Tcl_GetDoubleFromObj(interp, objPtr, doublePtr) \
- (tclStubsPtr->tcl_GetDoubleFromObj)(interp, objPtr, doublePtr) /* 35 */
+#define Tcl_GetDoubleFromObj \
+ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
#endif
#ifndef Tcl_GetIndexFromObj
-#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
- (tclStubsPtr->tcl_GetIndexFromObj)(interp, objPtr, tablePtr, msg, flags, indexPtr) /* 36 */
+#define Tcl_GetIndexFromObj \
+ (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
#endif
#ifndef Tcl_GetInt
-#define Tcl_GetInt(interp, string, intPtr) \
- (tclStubsPtr->tcl_GetInt)(interp, string, intPtr) /* 37 */
+#define Tcl_GetInt \
+ (tclStubsPtr->tcl_GetInt) /* 37 */
#endif
#ifndef Tcl_GetIntFromObj
-#define Tcl_GetIntFromObj(interp, objPtr, intPtr) \
- (tclStubsPtr->tcl_GetIntFromObj)(interp, objPtr, intPtr) /* 38 */
+#define Tcl_GetIntFromObj \
+ (tclStubsPtr->tcl_GetIntFromObj) /* 38 */
#endif
#ifndef Tcl_GetLongFromObj
-#define Tcl_GetLongFromObj(interp, objPtr, longPtr) \
- (tclStubsPtr->tcl_GetLongFromObj)(interp, objPtr, longPtr) /* 39 */
+#define Tcl_GetLongFromObj \
+ (tclStubsPtr->tcl_GetLongFromObj) /* 39 */
#endif
#ifndef Tcl_GetObjType
-#define Tcl_GetObjType(typeName) \
- (tclStubsPtr->tcl_GetObjType)(typeName) /* 40 */
+#define Tcl_GetObjType \
+ (tclStubsPtr->tcl_GetObjType) /* 40 */
#endif
#ifndef Tcl_GetStringFromObj
-#define Tcl_GetStringFromObj(objPtr, lengthPtr) \
- (tclStubsPtr->tcl_GetStringFromObj)(objPtr, lengthPtr) /* 41 */
+#define Tcl_GetStringFromObj \
+ (tclStubsPtr->tcl_GetStringFromObj) /* 41 */
#endif
#ifndef Tcl_InvalidateStringRep
-#define Tcl_InvalidateStringRep(objPtr) \
- (tclStubsPtr->tcl_InvalidateStringRep)(objPtr) /* 42 */
+#define Tcl_InvalidateStringRep \
+ (tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
#endif
#ifndef Tcl_ListObjAppendList
-#define Tcl_ListObjAppendList(interp, listPtr, elemListPtr) \
- (tclStubsPtr->tcl_ListObjAppendList)(interp, listPtr, elemListPtr) /* 43 */
+#define Tcl_ListObjAppendList \
+ (tclStubsPtr->tcl_ListObjAppendList) /* 43 */
#endif
#ifndef Tcl_ListObjAppendElement
-#define Tcl_ListObjAppendElement(interp, listPtr, objPtr) \
- (tclStubsPtr->tcl_ListObjAppendElement)(interp, listPtr, objPtr) /* 44 */
+#define Tcl_ListObjAppendElement \
+ (tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
#endif
#ifndef Tcl_ListObjGetElements
-#define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) \
- (tclStubsPtr->tcl_ListObjGetElements)(interp, listPtr, objcPtr, objvPtr) /* 45 */
+#define Tcl_ListObjGetElements \
+ (tclStubsPtr->tcl_ListObjGetElements) /* 45 */
#endif
#ifndef Tcl_ListObjIndex
-#define Tcl_ListObjIndex(interp, listPtr, index, objPtrPtr) \
- (tclStubsPtr->tcl_ListObjIndex)(interp, listPtr, index, objPtrPtr) /* 46 */
+#define Tcl_ListObjIndex \
+ (tclStubsPtr->tcl_ListObjIndex) /* 46 */
#endif
#ifndef Tcl_ListObjLength
-#define Tcl_ListObjLength(interp, listPtr, intPtr) \
- (tclStubsPtr->tcl_ListObjLength)(interp, listPtr, intPtr) /* 47 */
+#define Tcl_ListObjLength \
+ (tclStubsPtr->tcl_ListObjLength) /* 47 */
#endif
#ifndef Tcl_ListObjReplace
-#define Tcl_ListObjReplace(interp, listPtr, first, count, objc, objv) \
- (tclStubsPtr->tcl_ListObjReplace)(interp, listPtr, first, count, objc, objv) /* 48 */
+#define Tcl_ListObjReplace \
+ (tclStubsPtr->tcl_ListObjReplace) /* 48 */
#endif
#ifndef Tcl_NewBooleanObj
-#define Tcl_NewBooleanObj(boolValue) \
- (tclStubsPtr->tcl_NewBooleanObj)(boolValue) /* 49 */
+#define Tcl_NewBooleanObj \
+ (tclStubsPtr->tcl_NewBooleanObj) /* 49 */
#endif
#ifndef Tcl_NewByteArrayObj
-#define Tcl_NewByteArrayObj(bytes, length) \
- (tclStubsPtr->tcl_NewByteArrayObj)(bytes, length) /* 50 */
+#define Tcl_NewByteArrayObj \
+ (tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#endif
#ifndef Tcl_NewDoubleObj
-#define Tcl_NewDoubleObj(doubleValue) \
- (tclStubsPtr->tcl_NewDoubleObj)(doubleValue) /* 51 */
+#define Tcl_NewDoubleObj \
+ (tclStubsPtr->tcl_NewDoubleObj) /* 51 */
#endif
#ifndef Tcl_NewIntObj
-#define Tcl_NewIntObj(intValue) \
- (tclStubsPtr->tcl_NewIntObj)(intValue) /* 52 */
+#define Tcl_NewIntObj \
+ (tclStubsPtr->tcl_NewIntObj) /* 52 */
#endif
#ifndef Tcl_NewListObj
-#define Tcl_NewListObj(objc, objv) \
- (tclStubsPtr->tcl_NewListObj)(objc, objv) /* 53 */
+#define Tcl_NewListObj \
+ (tclStubsPtr->tcl_NewListObj) /* 53 */
#endif
#ifndef Tcl_NewLongObj
-#define Tcl_NewLongObj(longValue) \
- (tclStubsPtr->tcl_NewLongObj)(longValue) /* 54 */
+#define Tcl_NewLongObj \
+ (tclStubsPtr->tcl_NewLongObj) /* 54 */
#endif
#ifndef Tcl_NewObj
-#define Tcl_NewObj() \
- (tclStubsPtr->tcl_NewObj)() /* 55 */
+#define Tcl_NewObj \
+ (tclStubsPtr->tcl_NewObj) /* 55 */
#endif
#ifndef Tcl_NewStringObj
-#define Tcl_NewStringObj(bytes, length) \
- (tclStubsPtr->tcl_NewStringObj)(bytes, length) /* 56 */
+#define Tcl_NewStringObj \
+ (tclStubsPtr->tcl_NewStringObj) /* 56 */
#endif
#ifndef Tcl_SetBooleanObj
-#define Tcl_SetBooleanObj(objPtr, boolValue) \
- (tclStubsPtr->tcl_SetBooleanObj)(objPtr, boolValue) /* 57 */
+#define Tcl_SetBooleanObj \
+ (tclStubsPtr->tcl_SetBooleanObj) /* 57 */
#endif
#ifndef Tcl_SetByteArrayLength
-#define Tcl_SetByteArrayLength(objPtr, length) \
- (tclStubsPtr->tcl_SetByteArrayLength)(objPtr, length) /* 58 */
+#define Tcl_SetByteArrayLength \
+ (tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#endif
#ifndef Tcl_SetByteArrayObj
-#define Tcl_SetByteArrayObj(objPtr, bytes, length) \
- (tclStubsPtr->tcl_SetByteArrayObj)(objPtr, bytes, length) /* 59 */
+#define Tcl_SetByteArrayObj \
+ (tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#endif
#ifndef Tcl_SetDoubleObj
-#define Tcl_SetDoubleObj(objPtr, doubleValue) \
- (tclStubsPtr->tcl_SetDoubleObj)(objPtr, doubleValue) /* 60 */
+#define Tcl_SetDoubleObj \
+ (tclStubsPtr->tcl_SetDoubleObj) /* 60 */
#endif
#ifndef Tcl_SetIntObj
-#define Tcl_SetIntObj(objPtr, intValue) \
- (tclStubsPtr->tcl_SetIntObj)(objPtr, intValue) /* 61 */
+#define Tcl_SetIntObj \
+ (tclStubsPtr->tcl_SetIntObj) /* 61 */
#endif
#ifndef Tcl_SetListObj
-#define Tcl_SetListObj(objPtr, objc, objv) \
- (tclStubsPtr->tcl_SetListObj)(objPtr, objc, objv) /* 62 */
+#define Tcl_SetListObj \
+ (tclStubsPtr->tcl_SetListObj) /* 62 */
#endif
#ifndef Tcl_SetLongObj
-#define Tcl_SetLongObj(objPtr, longValue) \
- (tclStubsPtr->tcl_SetLongObj)(objPtr, longValue) /* 63 */
+#define Tcl_SetLongObj \
+ (tclStubsPtr->tcl_SetLongObj) /* 63 */
#endif
#ifndef Tcl_SetObjLength
-#define Tcl_SetObjLength(objPtr, length) \
- (tclStubsPtr->tcl_SetObjLength)(objPtr, length) /* 64 */
+#define Tcl_SetObjLength \
+ (tclStubsPtr->tcl_SetObjLength) /* 64 */
#endif
#ifndef Tcl_SetStringObj
-#define Tcl_SetStringObj(objPtr, bytes, length) \
- (tclStubsPtr->tcl_SetStringObj)(objPtr, bytes, length) /* 65 */
+#define Tcl_SetStringObj \
+ (tclStubsPtr->tcl_SetStringObj) /* 65 */
#endif
#ifndef Tcl_AddErrorInfo
-#define Tcl_AddErrorInfo(interp, message) \
- (tclStubsPtr->tcl_AddErrorInfo)(interp, message) /* 66 */
+#define Tcl_AddErrorInfo \
+ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */
#endif
#ifndef Tcl_AddObjErrorInfo
-#define Tcl_AddObjErrorInfo(interp, message, length) \
- (tclStubsPtr->tcl_AddObjErrorInfo)(interp, message, length) /* 67 */
+#define Tcl_AddObjErrorInfo \
+ (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
#endif
#ifndef Tcl_AllowExceptions
-#define Tcl_AllowExceptions(interp) \
- (tclStubsPtr->tcl_AllowExceptions)(interp) /* 68 */
+#define Tcl_AllowExceptions \
+ (tclStubsPtr->tcl_AllowExceptions) /* 68 */
#endif
#ifndef Tcl_AppendElement
-#define Tcl_AppendElement(interp, string) \
- (tclStubsPtr->tcl_AppendElement)(interp, string) /* 69 */
+#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(proc, clientData) \
- (tclStubsPtr->tcl_AsyncCreate)(proc, clientData) /* 71 */
+#define Tcl_AsyncCreate \
+ (tclStubsPtr->tcl_AsyncCreate) /* 71 */
#endif
#ifndef Tcl_AsyncDelete
-#define Tcl_AsyncDelete(async) \
- (tclStubsPtr->tcl_AsyncDelete)(async) /* 72 */
+#define Tcl_AsyncDelete \
+ (tclStubsPtr->tcl_AsyncDelete) /* 72 */
#endif
#ifndef Tcl_AsyncInvoke
-#define Tcl_AsyncInvoke(interp, code) \
- (tclStubsPtr->tcl_AsyncInvoke)(interp, code) /* 73 */
+#define Tcl_AsyncInvoke \
+ (tclStubsPtr->tcl_AsyncInvoke) /* 73 */
#endif
#ifndef Tcl_AsyncMark
-#define Tcl_AsyncMark(async) \
- (tclStubsPtr->tcl_AsyncMark)(async) /* 74 */
+#define Tcl_AsyncMark \
+ (tclStubsPtr->tcl_AsyncMark) /* 74 */
#endif
#ifndef Tcl_AsyncReady
-#define Tcl_AsyncReady() \
- (tclStubsPtr->tcl_AsyncReady)() /* 75 */
+#define Tcl_AsyncReady \
+ (tclStubsPtr->tcl_AsyncReady) /* 75 */
#endif
#ifndef Tcl_BackgroundError
-#define Tcl_BackgroundError(interp) \
- (tclStubsPtr->tcl_BackgroundError)(interp) /* 76 */
+#define Tcl_BackgroundError \
+ (tclStubsPtr->tcl_BackgroundError) /* 76 */
#endif
#ifndef Tcl_Backslash
-#define Tcl_Backslash(src, readPtr) \
- (tclStubsPtr->tcl_Backslash)(src, readPtr) /* 77 */
+#define Tcl_Backslash \
+ (tclStubsPtr->tcl_Backslash) /* 77 */
#endif
#ifndef Tcl_BadChannelOption
-#define Tcl_BadChannelOption(interp, optionName, optionList) \
- (tclStubsPtr->tcl_BadChannelOption)(interp, optionName, optionList) /* 78 */
+#define Tcl_BadChannelOption \
+ (tclStubsPtr->tcl_BadChannelOption) /* 78 */
#endif
#ifndef Tcl_CallWhenDeleted
-#define Tcl_CallWhenDeleted(interp, proc, clientData) \
- (tclStubsPtr->tcl_CallWhenDeleted)(interp, proc, clientData) /* 79 */
+#define Tcl_CallWhenDeleted \
+ (tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
#endif
#ifndef Tcl_CancelIdleCall
-#define Tcl_CancelIdleCall(idleProc, clientData) \
- (tclStubsPtr->tcl_CancelIdleCall)(idleProc, clientData) /* 80 */
+#define Tcl_CancelIdleCall \
+ (tclStubsPtr->tcl_CancelIdleCall) /* 80 */
#endif
#ifndef Tcl_Close
-#define Tcl_Close(interp, chan) \
- (tclStubsPtr->tcl_Close)(interp, chan) /* 81 */
+#define Tcl_Close \
+ (tclStubsPtr->tcl_Close) /* 81 */
#endif
#ifndef Tcl_CommandComplete
-#define Tcl_CommandComplete(cmd) \
- (tclStubsPtr->tcl_CommandComplete)(cmd) /* 82 */
+#define Tcl_CommandComplete \
+ (tclStubsPtr->tcl_CommandComplete) /* 82 */
#endif
#ifndef Tcl_Concat
-#define Tcl_Concat(argc, argv) \
- (tclStubsPtr->tcl_Concat)(argc, argv) /* 83 */
+#define Tcl_Concat \
+ (tclStubsPtr->tcl_Concat) /* 83 */
#endif
#ifndef Tcl_ConvertElement
-#define Tcl_ConvertElement(src, dst, flags) \
- (tclStubsPtr->tcl_ConvertElement)(src, dst, flags) /* 84 */
+#define Tcl_ConvertElement \
+ (tclStubsPtr->tcl_ConvertElement) /* 84 */
#endif
#ifndef Tcl_ConvertCountedElement
-#define Tcl_ConvertCountedElement(src, length, dst, flags) \
- (tclStubsPtr->tcl_ConvertCountedElement)(src, length, dst, flags) /* 85 */
+#define Tcl_ConvertCountedElement \
+ (tclStubsPtr->tcl_ConvertCountedElement) /* 85 */
#endif
#ifndef Tcl_CreateAlias
-#define Tcl_CreateAlias(slave, slaveCmd, target, targetCmd, argc, argv) \
- (tclStubsPtr->tcl_CreateAlias)(slave, slaveCmd, target, targetCmd, argc, argv) /* 86 */
+#define Tcl_CreateAlias \
+ (tclStubsPtr->tcl_CreateAlias) /* 86 */
#endif
#ifndef Tcl_CreateAliasObj
-#define Tcl_CreateAliasObj(slave, slaveCmd, target, targetCmd, objc, objv) \
- (tclStubsPtr->tcl_CreateAliasObj)(slave, slaveCmd, target, targetCmd, objc, objv) /* 87 */
+#define Tcl_CreateAliasObj \
+ (tclStubsPtr->tcl_CreateAliasObj) /* 87 */
#endif
#ifndef Tcl_CreateChannel
-#define Tcl_CreateChannel(typePtr, chanName, instanceData, mask) \
- (tclStubsPtr->tcl_CreateChannel)(typePtr, chanName, instanceData, mask) /* 88 */
+#define Tcl_CreateChannel \
+ (tclStubsPtr->tcl_CreateChannel) /* 88 */
#endif
#ifndef Tcl_CreateChannelHandler
-#define Tcl_CreateChannelHandler(chan, mask, proc, clientData) \
- (tclStubsPtr->tcl_CreateChannelHandler)(chan, mask, proc, clientData) /* 89 */
+#define Tcl_CreateChannelHandler \
+ (tclStubsPtr->tcl_CreateChannelHandler) /* 89 */
#endif
#ifndef Tcl_CreateCloseHandler
-#define Tcl_CreateCloseHandler(chan, proc, clientData) \
- (tclStubsPtr->tcl_CreateCloseHandler)(chan, proc, clientData) /* 90 */
+#define Tcl_CreateCloseHandler \
+ (tclStubsPtr->tcl_CreateCloseHandler) /* 90 */
#endif
#ifndef Tcl_CreateCommand
-#define Tcl_CreateCommand(interp, cmdName, proc, clientData, deleteProc) \
- (tclStubsPtr->tcl_CreateCommand)(interp, cmdName, proc, clientData, deleteProc) /* 91 */
+#define Tcl_CreateCommand \
+ (tclStubsPtr->tcl_CreateCommand) /* 91 */
#endif
#ifndef Tcl_CreateEventSource
-#define Tcl_CreateEventSource(setupProc, checkProc, clientData) \
- (tclStubsPtr->tcl_CreateEventSource)(setupProc, checkProc, clientData) /* 92 */
+#define Tcl_CreateEventSource \
+ (tclStubsPtr->tcl_CreateEventSource) /* 92 */
#endif
#ifndef Tcl_CreateExitHandler
-#define Tcl_CreateExitHandler(proc, clientData) \
- (tclStubsPtr->tcl_CreateExitHandler)(proc, clientData) /* 93 */
+#define Tcl_CreateExitHandler \
+ (tclStubsPtr->tcl_CreateExitHandler) /* 93 */
#endif
#ifndef Tcl_CreateInterp
-#define Tcl_CreateInterp() \
- (tclStubsPtr->tcl_CreateInterp)() /* 94 */
+#define Tcl_CreateInterp \
+ (tclStubsPtr->tcl_CreateInterp) /* 94 */
#endif
#ifndef Tcl_CreateMathFunc
-#define Tcl_CreateMathFunc(interp, name, numArgs, argTypes, proc, clientData) \
- (tclStubsPtr->tcl_CreateMathFunc)(interp, name, numArgs, argTypes, proc, clientData) /* 95 */
+#define Tcl_CreateMathFunc \
+ (tclStubsPtr->tcl_CreateMathFunc) /* 95 */
#endif
#ifndef Tcl_CreateObjCommand
-#define Tcl_CreateObjCommand(interp, cmdName, proc, clientData, deleteProc) \
- (tclStubsPtr->tcl_CreateObjCommand)(interp, cmdName, proc, clientData, deleteProc) /* 96 */
+#define Tcl_CreateObjCommand \
+ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */
#endif
#ifndef Tcl_CreateSlave
-#define Tcl_CreateSlave(interp, slaveName, isSafe) \
- (tclStubsPtr->tcl_CreateSlave)(interp, slaveName, isSafe) /* 97 */
+#define Tcl_CreateSlave \
+ (tclStubsPtr->tcl_CreateSlave) /* 97 */
#endif
#ifndef Tcl_CreateTimerHandler
-#define Tcl_CreateTimerHandler(milliseconds, proc, clientData) \
- (tclStubsPtr->tcl_CreateTimerHandler)(milliseconds, proc, clientData) /* 98 */
+#define Tcl_CreateTimerHandler \
+ (tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
#endif
#ifndef Tcl_CreateTrace
-#define Tcl_CreateTrace(interp, level, proc, clientData) \
- (tclStubsPtr->tcl_CreateTrace)(interp, level, proc, clientData) /* 99 */
+#define Tcl_CreateTrace \
+ (tclStubsPtr->tcl_CreateTrace) /* 99 */
#endif
#ifndef Tcl_DeleteAssocData
-#define Tcl_DeleteAssocData(interp, name) \
- (tclStubsPtr->tcl_DeleteAssocData)(interp, name) /* 100 */
+#define Tcl_DeleteAssocData \
+ (tclStubsPtr->tcl_DeleteAssocData) /* 100 */
#endif
#ifndef Tcl_DeleteChannelHandler
-#define Tcl_DeleteChannelHandler(chan, proc, clientData) \
- (tclStubsPtr->tcl_DeleteChannelHandler)(chan, proc, clientData) /* 101 */
+#define Tcl_DeleteChannelHandler \
+ (tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */
#endif
#ifndef Tcl_DeleteCloseHandler
-#define Tcl_DeleteCloseHandler(chan, proc, clientData) \
- (tclStubsPtr->tcl_DeleteCloseHandler)(chan, proc, clientData) /* 102 */
+#define Tcl_DeleteCloseHandler \
+ (tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */
#endif
#ifndef Tcl_DeleteCommand
-#define Tcl_DeleteCommand(interp, cmdName) \
- (tclStubsPtr->tcl_DeleteCommand)(interp, cmdName) /* 103 */
+#define Tcl_DeleteCommand \
+ (tclStubsPtr->tcl_DeleteCommand) /* 103 */
#endif
#ifndef Tcl_DeleteCommandFromToken
-#define Tcl_DeleteCommandFromToken(interp, command) \
- (tclStubsPtr->tcl_DeleteCommandFromToken)(interp, command) /* 104 */
+#define Tcl_DeleteCommandFromToken \
+ (tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */
#endif
#ifndef Tcl_DeleteEvents
-#define Tcl_DeleteEvents(proc, clientData) \
- (tclStubsPtr->tcl_DeleteEvents)(proc, clientData) /* 105 */
+#define Tcl_DeleteEvents \
+ (tclStubsPtr->tcl_DeleteEvents) /* 105 */
#endif
#ifndef Tcl_DeleteEventSource
-#define Tcl_DeleteEventSource(setupProc, checkProc, clientData) \
- (tclStubsPtr->tcl_DeleteEventSource)(setupProc, checkProc, clientData) /* 106 */
+#define Tcl_DeleteEventSource \
+ (tclStubsPtr->tcl_DeleteEventSource) /* 106 */
#endif
#ifndef Tcl_DeleteExitHandler
-#define Tcl_DeleteExitHandler(proc, clientData) \
- (tclStubsPtr->tcl_DeleteExitHandler)(proc, clientData) /* 107 */
+#define Tcl_DeleteExitHandler \
+ (tclStubsPtr->tcl_DeleteExitHandler) /* 107 */
#endif
#ifndef Tcl_DeleteHashEntry
-#define Tcl_DeleteHashEntry(entryPtr) \
- (tclStubsPtr->tcl_DeleteHashEntry)(entryPtr) /* 108 */
+#define Tcl_DeleteHashEntry \
+ (tclStubsPtr->tcl_DeleteHashEntry) /* 108 */
#endif
#ifndef Tcl_DeleteHashTable
-#define Tcl_DeleteHashTable(tablePtr) \
- (tclStubsPtr->tcl_DeleteHashTable)(tablePtr) /* 109 */
+#define Tcl_DeleteHashTable \
+ (tclStubsPtr->tcl_DeleteHashTable) /* 109 */
#endif
#ifndef Tcl_DeleteInterp
-#define Tcl_DeleteInterp(interp) \
- (tclStubsPtr->tcl_DeleteInterp)(interp) /* 110 */
+#define Tcl_DeleteInterp \
+ (tclStubsPtr->tcl_DeleteInterp) /* 110 */
#endif
#ifndef Tcl_DetachPids
-#define Tcl_DetachPids(numPids, pidPtr) \
- (tclStubsPtr->tcl_DetachPids)(numPids, pidPtr) /* 111 */
+#define Tcl_DetachPids \
+ (tclStubsPtr->tcl_DetachPids) /* 111 */
#endif
#ifndef Tcl_DeleteTimerHandler
-#define Tcl_DeleteTimerHandler(token) \
- (tclStubsPtr->tcl_DeleteTimerHandler)(token) /* 112 */
+#define Tcl_DeleteTimerHandler \
+ (tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */
#endif
#ifndef Tcl_DeleteTrace
-#define Tcl_DeleteTrace(interp, trace) \
- (tclStubsPtr->tcl_DeleteTrace)(interp, trace) /* 113 */
+#define Tcl_DeleteTrace \
+ (tclStubsPtr->tcl_DeleteTrace) /* 113 */
#endif
#ifndef Tcl_DontCallWhenDeleted
-#define Tcl_DontCallWhenDeleted(interp, proc, clientData) \
- (tclStubsPtr->tcl_DontCallWhenDeleted)(interp, proc, clientData) /* 114 */
+#define Tcl_DontCallWhenDeleted \
+ (tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */
#endif
#ifndef Tcl_DoOneEvent
-#define Tcl_DoOneEvent(flags) \
- (tclStubsPtr->tcl_DoOneEvent)(flags) /* 115 */
+#define Tcl_DoOneEvent \
+ (tclStubsPtr->tcl_DoOneEvent) /* 115 */
#endif
#ifndef Tcl_DoWhenIdle
-#define Tcl_DoWhenIdle(proc, clientData) \
- (tclStubsPtr->tcl_DoWhenIdle)(proc, clientData) /* 116 */
+#define Tcl_DoWhenIdle \
+ (tclStubsPtr->tcl_DoWhenIdle) /* 116 */
#endif
#ifndef Tcl_DStringAppend
-#define Tcl_DStringAppend(dsPtr, string, length) \
- (tclStubsPtr->tcl_DStringAppend)(dsPtr, string, length) /* 117 */
+#define Tcl_DStringAppend \
+ (tclStubsPtr->tcl_DStringAppend) /* 117 */
#endif
#ifndef Tcl_DStringAppendElement
-#define Tcl_DStringAppendElement(dsPtr, string) \
- (tclStubsPtr->tcl_DStringAppendElement)(dsPtr, string) /* 118 */
+#define Tcl_DStringAppendElement \
+ (tclStubsPtr->tcl_DStringAppendElement) /* 118 */
#endif
#ifndef Tcl_DStringEndSublist
-#define Tcl_DStringEndSublist(dsPtr) \
- (tclStubsPtr->tcl_DStringEndSublist)(dsPtr) /* 119 */
+#define Tcl_DStringEndSublist \
+ (tclStubsPtr->tcl_DStringEndSublist) /* 119 */
#endif
#ifndef Tcl_DStringFree
-#define Tcl_DStringFree(dsPtr) \
- (tclStubsPtr->tcl_DStringFree)(dsPtr) /* 120 */
+#define Tcl_DStringFree \
+ (tclStubsPtr->tcl_DStringFree) /* 120 */
#endif
#ifndef Tcl_DStringGetResult
-#define Tcl_DStringGetResult(interp, dsPtr) \
- (tclStubsPtr->tcl_DStringGetResult)(interp, dsPtr) /* 121 */
+#define Tcl_DStringGetResult \
+ (tclStubsPtr->tcl_DStringGetResult) /* 121 */
#endif
#ifndef Tcl_DStringInit
-#define Tcl_DStringInit(dsPtr) \
- (tclStubsPtr->tcl_DStringInit)(dsPtr) /* 122 */
+#define Tcl_DStringInit \
+ (tclStubsPtr->tcl_DStringInit) /* 122 */
#endif
#ifndef Tcl_DStringResult
-#define Tcl_DStringResult(interp, dsPtr) \
- (tclStubsPtr->tcl_DStringResult)(interp, dsPtr) /* 123 */
+#define Tcl_DStringResult \
+ (tclStubsPtr->tcl_DStringResult) /* 123 */
#endif
#ifndef Tcl_DStringSetLength
-#define Tcl_DStringSetLength(dsPtr, length) \
- (tclStubsPtr->tcl_DStringSetLength)(dsPtr, length) /* 124 */
+#define Tcl_DStringSetLength \
+ (tclStubsPtr->tcl_DStringSetLength) /* 124 */
#endif
#ifndef Tcl_DStringStartSublist
-#define Tcl_DStringStartSublist(dsPtr) \
- (tclStubsPtr->tcl_DStringStartSublist)(dsPtr) /* 125 */
+#define Tcl_DStringStartSublist \
+ (tclStubsPtr->tcl_DStringStartSublist) /* 125 */
#endif
#ifndef Tcl_Eof
-#define Tcl_Eof(chan) \
- (tclStubsPtr->tcl_Eof)(chan) /* 126 */
+#define Tcl_Eof \
+ (tclStubsPtr->tcl_Eof) /* 126 */
#endif
#ifndef Tcl_ErrnoId
-#define Tcl_ErrnoId() \
- (tclStubsPtr->tcl_ErrnoId)() /* 127 */
+#define Tcl_ErrnoId \
+ (tclStubsPtr->tcl_ErrnoId) /* 127 */
#endif
#ifndef Tcl_ErrnoMsg
-#define Tcl_ErrnoMsg(err) \
- (tclStubsPtr->tcl_ErrnoMsg)(err) /* 128 */
+#define Tcl_ErrnoMsg \
+ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */
#endif
#ifndef Tcl_Eval
-#define Tcl_Eval(interp, string) \
- (tclStubsPtr->tcl_Eval)(interp, string) /* 129 */
+#define Tcl_Eval \
+ (tclStubsPtr->tcl_Eval) /* 129 */
#endif
#ifndef Tcl_EvalFile
-#define Tcl_EvalFile(interp, fileName) \
- (tclStubsPtr->tcl_EvalFile)(interp, fileName) /* 130 */
+#define Tcl_EvalFile \
+ (tclStubsPtr->tcl_EvalFile) /* 130 */
#endif
#ifndef Tcl_EvalObj
-#define Tcl_EvalObj(interp, objPtr) \
- (tclStubsPtr->tcl_EvalObj)(interp, objPtr) /* 131 */
+#define Tcl_EvalObj \
+ (tclStubsPtr->tcl_EvalObj) /* 131 */
#endif
#ifndef Tcl_EventuallyFree
-#define Tcl_EventuallyFree(clientData, freeProc) \
- (tclStubsPtr->tcl_EventuallyFree)(clientData, freeProc) /* 132 */
+#define Tcl_EventuallyFree \
+ (tclStubsPtr->tcl_EventuallyFree) /* 132 */
#endif
#ifndef Tcl_Exit
-#define Tcl_Exit(status) \
- (tclStubsPtr->tcl_Exit)(status) /* 133 */
+#define Tcl_Exit \
+ (tclStubsPtr->tcl_Exit) /* 133 */
#endif
#ifndef Tcl_ExposeCommand
-#define Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName) \
- (tclStubsPtr->tcl_ExposeCommand)(interp, hiddenCmdToken, cmdName) /* 134 */
+#define Tcl_ExposeCommand \
+ (tclStubsPtr->tcl_ExposeCommand) /* 134 */
#endif
#ifndef Tcl_ExprBoolean
-#define Tcl_ExprBoolean(interp, string, ptr) \
- (tclStubsPtr->tcl_ExprBoolean)(interp, string, ptr) /* 135 */
+#define Tcl_ExprBoolean \
+ (tclStubsPtr->tcl_ExprBoolean) /* 135 */
#endif
#ifndef Tcl_ExprBooleanObj
-#define Tcl_ExprBooleanObj(interp, objPtr, ptr) \
- (tclStubsPtr->tcl_ExprBooleanObj)(interp, objPtr, ptr) /* 136 */
+#define Tcl_ExprBooleanObj \
+ (tclStubsPtr->tcl_ExprBooleanObj) /* 136 */
#endif
#ifndef Tcl_ExprDouble
-#define Tcl_ExprDouble(interp, string, ptr) \
- (tclStubsPtr->tcl_ExprDouble)(interp, string, ptr) /* 137 */
+#define Tcl_ExprDouble \
+ (tclStubsPtr->tcl_ExprDouble) /* 137 */
#endif
#ifndef Tcl_ExprDoubleObj
-#define Tcl_ExprDoubleObj(interp, objPtr, ptr) \
- (tclStubsPtr->tcl_ExprDoubleObj)(interp, objPtr, ptr) /* 138 */
+#define Tcl_ExprDoubleObj \
+ (tclStubsPtr->tcl_ExprDoubleObj) /* 138 */
#endif
#ifndef Tcl_ExprLong
-#define Tcl_ExprLong(interp, string, ptr) \
- (tclStubsPtr->tcl_ExprLong)(interp, string, ptr) /* 139 */
+#define Tcl_ExprLong \
+ (tclStubsPtr->tcl_ExprLong) /* 139 */
#endif
#ifndef Tcl_ExprLongObj
-#define Tcl_ExprLongObj(interp, objPtr, ptr) \
- (tclStubsPtr->tcl_ExprLongObj)(interp, objPtr, ptr) /* 140 */
+#define Tcl_ExprLongObj \
+ (tclStubsPtr->tcl_ExprLongObj) /* 140 */
#endif
#ifndef Tcl_ExprObj
-#define Tcl_ExprObj(interp, objPtr, resultPtrPtr) \
- (tclStubsPtr->tcl_ExprObj)(interp, objPtr, resultPtrPtr) /* 141 */
+#define Tcl_ExprObj \
+ (tclStubsPtr->tcl_ExprObj) /* 141 */
#endif
#ifndef Tcl_ExprString
-#define Tcl_ExprString(interp, string) \
- (tclStubsPtr->tcl_ExprString)(interp, string) /* 142 */
+#define Tcl_ExprString \
+ (tclStubsPtr->tcl_ExprString) /* 142 */
#endif
#ifndef Tcl_Finalize
-#define Tcl_Finalize() \
- (tclStubsPtr->tcl_Finalize)() /* 143 */
+#define Tcl_Finalize \
+ (tclStubsPtr->tcl_Finalize) /* 143 */
#endif
#ifndef Tcl_FindExecutable
-#define Tcl_FindExecutable(argv0) \
- (tclStubsPtr->tcl_FindExecutable)(argv0) /* 144 */
+#define Tcl_FindExecutable \
+ (tclStubsPtr->tcl_FindExecutable) /* 144 */
#endif
#ifndef Tcl_FirstHashEntry
-#define Tcl_FirstHashEntry(tablePtr, searchPtr) \
- (tclStubsPtr->tcl_FirstHashEntry)(tablePtr, searchPtr) /* 145 */
+#define Tcl_FirstHashEntry \
+ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */
#endif
#ifndef Tcl_Flush
-#define Tcl_Flush(chan) \
- (tclStubsPtr->tcl_Flush)(chan) /* 146 */
+#define Tcl_Flush \
+ (tclStubsPtr->tcl_Flush) /* 146 */
#endif
#ifndef Tcl_FreeResult
-#define Tcl_FreeResult(interp) \
- (tclStubsPtr->tcl_FreeResult)(interp) /* 147 */
+#define Tcl_FreeResult \
+ (tclStubsPtr->tcl_FreeResult) /* 147 */
#endif
#ifndef Tcl_GetAlias
-#define Tcl_GetAlias(interp, slaveCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr) \
- (tclStubsPtr->tcl_GetAlias)(interp, slaveCmd, targetInterpPtr, targetCmdPtr, argcPtr, argvPtr) /* 148 */
+#define Tcl_GetAlias \
+ (tclStubsPtr->tcl_GetAlias) /* 148 */
#endif
#ifndef Tcl_GetAliasObj
-#define Tcl_GetAliasObj(interp, slaveCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) \
- (tclStubsPtr->tcl_GetAliasObj)(interp, slaveCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) /* 149 */
+#define Tcl_GetAliasObj \
+ (tclStubsPtr->tcl_GetAliasObj) /* 149 */
#endif
#ifndef Tcl_GetAssocData
-#define Tcl_GetAssocData(interp, name, procPtr) \
- (tclStubsPtr->tcl_GetAssocData)(interp, name, procPtr) /* 150 */
+#define Tcl_GetAssocData \
+ (tclStubsPtr->tcl_GetAssocData) /* 150 */
#endif
#ifndef Tcl_GetChannel
-#define Tcl_GetChannel(interp, chanName, modePtr) \
- (tclStubsPtr->tcl_GetChannel)(interp, chanName, modePtr) /* 151 */
+#define Tcl_GetChannel \
+ (tclStubsPtr->tcl_GetChannel) /* 151 */
#endif
#ifndef Tcl_GetChannelBufferSize
-#define Tcl_GetChannelBufferSize(chan) \
- (tclStubsPtr->tcl_GetChannelBufferSize)(chan) /* 152 */
+#define Tcl_GetChannelBufferSize \
+ (tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */
#endif
#ifndef Tcl_GetChannelHandle
-#define Tcl_GetChannelHandle(chan, direction, handlePtr) \
- (tclStubsPtr->tcl_GetChannelHandle)(chan, direction, handlePtr) /* 153 */
+#define Tcl_GetChannelHandle \
+ (tclStubsPtr->tcl_GetChannelHandle) /* 153 */
#endif
#ifndef Tcl_GetChannelInstanceData
-#define Tcl_GetChannelInstanceData(chan) \
- (tclStubsPtr->tcl_GetChannelInstanceData)(chan) /* 154 */
+#define Tcl_GetChannelInstanceData \
+ (tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */
#endif
#ifndef Tcl_GetChannelMode
-#define Tcl_GetChannelMode(chan) \
- (tclStubsPtr->tcl_GetChannelMode)(chan) /* 155 */
+#define Tcl_GetChannelMode \
+ (tclStubsPtr->tcl_GetChannelMode) /* 155 */
#endif
#ifndef Tcl_GetChannelName
-#define Tcl_GetChannelName(chan) \
- (tclStubsPtr->tcl_GetChannelName)(chan) /* 156 */
+#define Tcl_GetChannelName \
+ (tclStubsPtr->tcl_GetChannelName) /* 156 */
#endif
#ifndef Tcl_GetChannelOption
-#define Tcl_GetChannelOption(interp, chan, optionName, dsPtr) \
- (tclStubsPtr->tcl_GetChannelOption)(interp, chan, optionName, dsPtr) /* 157 */
+#define Tcl_GetChannelOption \
+ (tclStubsPtr->tcl_GetChannelOption) /* 157 */
#endif
#ifndef Tcl_GetChannelType
-#define Tcl_GetChannelType(chan) \
- (tclStubsPtr->tcl_GetChannelType)(chan) /* 158 */
+#define Tcl_GetChannelType \
+ (tclStubsPtr->tcl_GetChannelType) /* 158 */
#endif
#ifndef Tcl_GetCommandInfo
-#define Tcl_GetCommandInfo(interp, cmdName, infoPtr) \
- (tclStubsPtr->tcl_GetCommandInfo)(interp, cmdName, infoPtr) /* 159 */
+#define Tcl_GetCommandInfo \
+ (tclStubsPtr->tcl_GetCommandInfo) /* 159 */
#endif
#ifndef Tcl_GetCommandName
-#define Tcl_GetCommandName(interp, command) \
- (tclStubsPtr->tcl_GetCommandName)(interp, command) /* 160 */
+#define Tcl_GetCommandName \
+ (tclStubsPtr->tcl_GetCommandName) /* 160 */
#endif
#ifndef Tcl_GetErrno
-#define Tcl_GetErrno() \
- (tclStubsPtr->tcl_GetErrno)() /* 161 */
+#define Tcl_GetErrno \
+ (tclStubsPtr->tcl_GetErrno) /* 161 */
#endif
#ifndef Tcl_GetHostName
-#define Tcl_GetHostName() \
- (tclStubsPtr->tcl_GetHostName)() /* 162 */
+#define Tcl_GetHostName \
+ (tclStubsPtr->tcl_GetHostName) /* 162 */
#endif
#ifndef Tcl_GetInterpPath
-#define Tcl_GetInterpPath(askInterp, slaveInterp) \
- (tclStubsPtr->tcl_GetInterpPath)(askInterp, slaveInterp) /* 163 */
+#define Tcl_GetInterpPath \
+ (tclStubsPtr->tcl_GetInterpPath) /* 163 */
#endif
#ifndef Tcl_GetMaster
-#define Tcl_GetMaster(interp) \
- (tclStubsPtr->tcl_GetMaster)(interp) /* 164 */
+#define Tcl_GetMaster \
+ (tclStubsPtr->tcl_GetMaster) /* 164 */
#endif
#ifndef Tcl_GetNameOfExecutable
-#define Tcl_GetNameOfExecutable() \
- (tclStubsPtr->tcl_GetNameOfExecutable)() /* 165 */
+#define Tcl_GetNameOfExecutable \
+ (tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#endif
#ifndef Tcl_GetObjResult
-#define Tcl_GetObjResult(interp) \
- (tclStubsPtr->tcl_GetObjResult)(interp) /* 166 */
+#define Tcl_GetObjResult \
+ (tclStubsPtr->tcl_GetObjResult) /* 166 */
#endif
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef Tcl_GetOpenFile
-#define Tcl_GetOpenFile(interp, string, write, checkUsage, filePtr) \
- (tclStubsPtr->tcl_GetOpenFile)(interp, string, write, checkUsage, filePtr) /* 167 */
+#define Tcl_GetOpenFile \
+ (tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif
#endif /* UNIX */
#ifndef Tcl_GetPathType
-#define Tcl_GetPathType(path) \
- (tclStubsPtr->tcl_GetPathType)(path) /* 168 */
+#define Tcl_GetPathType \
+ (tclStubsPtr->tcl_GetPathType) /* 168 */
#endif
#ifndef Tcl_Gets
-#define Tcl_Gets(chan, dsPtr) \
- (tclStubsPtr->tcl_Gets)(chan, dsPtr) /* 169 */
+#define Tcl_Gets \
+ (tclStubsPtr->tcl_Gets) /* 169 */
#endif
#ifndef Tcl_GetsObj
-#define Tcl_GetsObj(chan, objPtr) \
- (tclStubsPtr->tcl_GetsObj)(chan, objPtr) /* 170 */
+#define Tcl_GetsObj \
+ (tclStubsPtr->tcl_GetsObj) /* 170 */
#endif
#ifndef Tcl_GetServiceMode
-#define Tcl_GetServiceMode() \
- (tclStubsPtr->tcl_GetServiceMode)() /* 171 */
+#define Tcl_GetServiceMode \
+ (tclStubsPtr->tcl_GetServiceMode) /* 171 */
#endif
#ifndef Tcl_GetSlave
-#define Tcl_GetSlave(interp, slaveName) \
- (tclStubsPtr->tcl_GetSlave)(interp, slaveName) /* 172 */
+#define Tcl_GetSlave \
+ (tclStubsPtr->tcl_GetSlave) /* 172 */
#endif
#ifndef Tcl_GetStdChannel
-#define Tcl_GetStdChannel(type) \
- (tclStubsPtr->tcl_GetStdChannel)(type) /* 173 */
+#define Tcl_GetStdChannel \
+ (tclStubsPtr->tcl_GetStdChannel) /* 173 */
#endif
#ifndef Tcl_GetStringResult
-#define Tcl_GetStringResult(interp) \
- (tclStubsPtr->tcl_GetStringResult)(interp) /* 174 */
+#define Tcl_GetStringResult \
+ (tclStubsPtr->tcl_GetStringResult) /* 174 */
#endif
#ifndef Tcl_GetVar
-#define Tcl_GetVar(interp, varName, flags) \
- (tclStubsPtr->tcl_GetVar)(interp, varName, flags) /* 175 */
+#define Tcl_GetVar \
+ (tclStubsPtr->tcl_GetVar) /* 175 */
#endif
#ifndef Tcl_GetVar2
-#define Tcl_GetVar2(interp, part1, part2, flags) \
- (tclStubsPtr->tcl_GetVar2)(interp, part1, part2, flags) /* 176 */
+#define Tcl_GetVar2 \
+ (tclStubsPtr->tcl_GetVar2) /* 176 */
#endif
#ifndef Tcl_GlobalEval
-#define Tcl_GlobalEval(interp, command) \
- (tclStubsPtr->tcl_GlobalEval)(interp, command) /* 177 */
+#define Tcl_GlobalEval \
+ (tclStubsPtr->tcl_GlobalEval) /* 177 */
#endif
#ifndef Tcl_GlobalEvalObj
-#define Tcl_GlobalEvalObj(interp, objPtr) \
- (tclStubsPtr->tcl_GlobalEvalObj)(interp, objPtr) /* 178 */
+#define Tcl_GlobalEvalObj \
+ (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
#endif
#ifndef Tcl_HideCommand
-#define Tcl_HideCommand(interp, cmdName, hiddenCmdToken) \
- (tclStubsPtr->tcl_HideCommand)(interp, cmdName, hiddenCmdToken) /* 179 */
+#define Tcl_HideCommand \
+ (tclStubsPtr->tcl_HideCommand) /* 179 */
#endif
#ifndef Tcl_Init
-#define Tcl_Init(interp) \
- (tclStubsPtr->tcl_Init)(interp) /* 180 */
+#define Tcl_Init \
+ (tclStubsPtr->tcl_Init) /* 180 */
#endif
#ifndef Tcl_InitHashTable
-#define Tcl_InitHashTable(tablePtr, keyType) \
- (tclStubsPtr->tcl_InitHashTable)(tablePtr, keyType) /* 181 */
+#define Tcl_InitHashTable \
+ (tclStubsPtr->tcl_InitHashTable) /* 181 */
#endif
#ifndef Tcl_InputBlocked
-#define Tcl_InputBlocked(chan) \
- (tclStubsPtr->tcl_InputBlocked)(chan) /* 182 */
+#define Tcl_InputBlocked \
+ (tclStubsPtr->tcl_InputBlocked) /* 182 */
#endif
#ifndef Tcl_InputBuffered
-#define Tcl_InputBuffered(chan) \
- (tclStubsPtr->tcl_InputBuffered)(chan) /* 183 */
+#define Tcl_InputBuffered \
+ (tclStubsPtr->tcl_InputBuffered) /* 183 */
#endif
#ifndef Tcl_InterpDeleted
-#define Tcl_InterpDeleted(interp) \
- (tclStubsPtr->tcl_InterpDeleted)(interp) /* 184 */
+#define Tcl_InterpDeleted \
+ (tclStubsPtr->tcl_InterpDeleted) /* 184 */
#endif
#ifndef Tcl_IsSafe
-#define Tcl_IsSafe(interp) \
- (tclStubsPtr->tcl_IsSafe)(interp) /* 185 */
+#define Tcl_IsSafe \
+ (tclStubsPtr->tcl_IsSafe) /* 185 */
#endif
#ifndef Tcl_JoinPath
-#define Tcl_JoinPath(argc, argv, resultPtr) \
- (tclStubsPtr->tcl_JoinPath)(argc, argv, resultPtr) /* 186 */
+#define Tcl_JoinPath \
+ (tclStubsPtr->tcl_JoinPath) /* 186 */
#endif
#ifndef Tcl_LinkVar
-#define Tcl_LinkVar(interp, varName, addr, type) \
- (tclStubsPtr->tcl_LinkVar)(interp, varName, addr, type) /* 187 */
+#define Tcl_LinkVar \
+ (tclStubsPtr->tcl_LinkVar) /* 187 */
#endif
/* Slot 188 is reserved */
#ifndef Tcl_MakeFileChannel
-#define Tcl_MakeFileChannel(handle, mode) \
- (tclStubsPtr->tcl_MakeFileChannel)(handle, mode) /* 189 */
+#define Tcl_MakeFileChannel \
+ (tclStubsPtr->tcl_MakeFileChannel) /* 189 */
#endif
#ifndef Tcl_MakeSafe
-#define Tcl_MakeSafe(interp) \
- (tclStubsPtr->tcl_MakeSafe)(interp) /* 190 */
+#define Tcl_MakeSafe \
+ (tclStubsPtr->tcl_MakeSafe) /* 190 */
#endif
#ifndef Tcl_MakeTcpClientChannel
-#define Tcl_MakeTcpClientChannel(tcpSocket) \
- (tclStubsPtr->tcl_MakeTcpClientChannel)(tcpSocket) /* 191 */
+#define Tcl_MakeTcpClientChannel \
+ (tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */
#endif
#ifndef Tcl_Merge
-#define Tcl_Merge(argc, argv) \
- (tclStubsPtr->tcl_Merge)(argc, argv) /* 192 */
+#define Tcl_Merge \
+ (tclStubsPtr->tcl_Merge) /* 192 */
#endif
#ifndef Tcl_NextHashEntry
-#define Tcl_NextHashEntry(searchPtr) \
- (tclStubsPtr->tcl_NextHashEntry)(searchPtr) /* 193 */
+#define Tcl_NextHashEntry \
+ (tclStubsPtr->tcl_NextHashEntry) /* 193 */
#endif
#ifndef Tcl_NotifyChannel
-#define Tcl_NotifyChannel(channel, mask) \
- (tclStubsPtr->tcl_NotifyChannel)(channel, mask) /* 194 */
+#define Tcl_NotifyChannel \
+ (tclStubsPtr->tcl_NotifyChannel) /* 194 */
#endif
#ifndef Tcl_ObjGetVar2
-#define Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags) \
- (tclStubsPtr->tcl_ObjGetVar2)(interp, part1Ptr, part2Ptr, flags) /* 195 */
+#define Tcl_ObjGetVar2 \
+ (tclStubsPtr->tcl_ObjGetVar2) /* 195 */
#endif
#ifndef Tcl_ObjSetVar2
-#define Tcl_ObjSetVar2(interp, part1Ptr, part2Ptr, newValuePtr, flags) \
- (tclStubsPtr->tcl_ObjSetVar2)(interp, part1Ptr, part2Ptr, newValuePtr, flags) /* 196 */
+#define Tcl_ObjSetVar2 \
+ (tclStubsPtr->tcl_ObjSetVar2) /* 196 */
#endif
#ifndef Tcl_OpenCommandChannel
-#define Tcl_OpenCommandChannel(interp, argc, argv, flags) \
- (tclStubsPtr->tcl_OpenCommandChannel)(interp, argc, argv, flags) /* 197 */
+#define Tcl_OpenCommandChannel \
+ (tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
#endif
#ifndef Tcl_OpenFileChannel
-#define Tcl_OpenFileChannel(interp, fileName, modeString, permissions) \
- (tclStubsPtr->tcl_OpenFileChannel)(interp, fileName, modeString, permissions) /* 198 */
+#define Tcl_OpenFileChannel \
+ (tclStubsPtr->tcl_OpenFileChannel) /* 198 */
#endif
#ifndef Tcl_OpenTcpClient
-#define Tcl_OpenTcpClient(interp, port, address, myaddr, myport, async) \
- (tclStubsPtr->tcl_OpenTcpClient)(interp, port, address, myaddr, myport, async) /* 199 */
+#define Tcl_OpenTcpClient \
+ (tclStubsPtr->tcl_OpenTcpClient) /* 199 */
#endif
#ifndef Tcl_OpenTcpServer
-#define Tcl_OpenTcpServer(interp, port, host, acceptProc, callbackData) \
- (tclStubsPtr->tcl_OpenTcpServer)(interp, port, host, acceptProc, callbackData) /* 200 */
+#define Tcl_OpenTcpServer \
+ (tclStubsPtr->tcl_OpenTcpServer) /* 200 */
#endif
#ifndef Tcl_Preserve
-#define Tcl_Preserve(data) \
- (tclStubsPtr->tcl_Preserve)(data) /* 201 */
+#define Tcl_Preserve \
+ (tclStubsPtr->tcl_Preserve) /* 201 */
#endif
#ifndef Tcl_PrintDouble
-#define Tcl_PrintDouble(interp, value, dst) \
- (tclStubsPtr->tcl_PrintDouble)(interp, value, dst) /* 202 */
+#define Tcl_PrintDouble \
+ (tclStubsPtr->tcl_PrintDouble) /* 202 */
#endif
#ifndef Tcl_PutEnv
-#define Tcl_PutEnv(string) \
- (tclStubsPtr->tcl_PutEnv)(string) /* 203 */
+#define Tcl_PutEnv \
+ (tclStubsPtr->tcl_PutEnv) /* 203 */
#endif
#ifndef Tcl_PosixError
-#define Tcl_PosixError(interp) \
- (tclStubsPtr->tcl_PosixError)(interp) /* 204 */
+#define Tcl_PosixError \
+ (tclStubsPtr->tcl_PosixError) /* 204 */
#endif
#ifndef Tcl_QueueEvent
-#define Tcl_QueueEvent(evPtr, position) \
- (tclStubsPtr->tcl_QueueEvent)(evPtr, position) /* 205 */
+#define Tcl_QueueEvent \
+ (tclStubsPtr->tcl_QueueEvent) /* 205 */
#endif
#ifndef Tcl_Read
-#define Tcl_Read(chan, bufPtr, toRead) \
- (tclStubsPtr->tcl_Read)(chan, bufPtr, toRead) /* 206 */
+#define Tcl_Read \
+ (tclStubsPtr->tcl_Read) /* 206 */
#endif
#ifndef Tcl_ReapDetachedProcs
-#define Tcl_ReapDetachedProcs() \
- (tclStubsPtr->tcl_ReapDetachedProcs)() /* 207 */
+#define Tcl_ReapDetachedProcs \
+ (tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
#endif
#ifndef Tcl_RecordAndEval
-#define Tcl_RecordAndEval(interp, cmd, flags) \
- (tclStubsPtr->tcl_RecordAndEval)(interp, cmd, flags) /* 208 */
+#define Tcl_RecordAndEval \
+ (tclStubsPtr->tcl_RecordAndEval) /* 208 */
#endif
#ifndef Tcl_RecordAndEvalObj
-#define Tcl_RecordAndEvalObj(interp, cmdPtr, flags) \
- (tclStubsPtr->tcl_RecordAndEvalObj)(interp, cmdPtr, flags) /* 209 */
+#define Tcl_RecordAndEvalObj \
+ (tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */
#endif
#ifndef Tcl_RegisterChannel
-#define Tcl_RegisterChannel(interp, chan) \
- (tclStubsPtr->tcl_RegisterChannel)(interp, chan) /* 210 */
+#define Tcl_RegisterChannel \
+ (tclStubsPtr->tcl_RegisterChannel) /* 210 */
#endif
#ifndef Tcl_RegisterObjType
-#define Tcl_RegisterObjType(typePtr) \
- (tclStubsPtr->tcl_RegisterObjType)(typePtr) /* 211 */
+#define Tcl_RegisterObjType \
+ (tclStubsPtr->tcl_RegisterObjType) /* 211 */
#endif
#ifndef Tcl_RegExpCompile
-#define Tcl_RegExpCompile(interp, string) \
- (tclStubsPtr->tcl_RegExpCompile)(interp, string) /* 212 */
+#define Tcl_RegExpCompile \
+ (tclStubsPtr->tcl_RegExpCompile) /* 212 */
#endif
#ifndef Tcl_RegExpExec
-#define Tcl_RegExpExec(interp, regexp, string, start) \
- (tclStubsPtr->tcl_RegExpExec)(interp, regexp, string, start) /* 213 */
+#define Tcl_RegExpExec \
+ (tclStubsPtr->tcl_RegExpExec) /* 213 */
#endif
#ifndef Tcl_RegExpMatch
-#define Tcl_RegExpMatch(interp, string, pattern) \
- (tclStubsPtr->tcl_RegExpMatch)(interp, string, pattern) /* 214 */
+#define Tcl_RegExpMatch \
+ (tclStubsPtr->tcl_RegExpMatch) /* 214 */
#endif
#ifndef Tcl_RegExpRange
-#define Tcl_RegExpRange(regexp, index, startPtr, endPtr) \
- (tclStubsPtr->tcl_RegExpRange)(regexp, index, startPtr, endPtr) /* 215 */
+#define Tcl_RegExpRange \
+ (tclStubsPtr->tcl_RegExpRange) /* 215 */
#endif
#ifndef Tcl_Release
-#define Tcl_Release(clientData) \
- (tclStubsPtr->tcl_Release)(clientData) /* 216 */
+#define Tcl_Release \
+ (tclStubsPtr->tcl_Release) /* 216 */
#endif
#ifndef Tcl_ResetResult
-#define Tcl_ResetResult(interp) \
- (tclStubsPtr->tcl_ResetResult)(interp) /* 217 */
+#define Tcl_ResetResult \
+ (tclStubsPtr->tcl_ResetResult) /* 217 */
#endif
#ifndef Tcl_ScanElement
-#define Tcl_ScanElement(string, flagPtr) \
- (tclStubsPtr->tcl_ScanElement)(string, flagPtr) /* 218 */
+#define Tcl_ScanElement \
+ (tclStubsPtr->tcl_ScanElement) /* 218 */
#endif
#ifndef Tcl_ScanCountedElement
-#define Tcl_ScanCountedElement(string, length, flagPtr) \
- (tclStubsPtr->tcl_ScanCountedElement)(string, length, flagPtr) /* 219 */
+#define Tcl_ScanCountedElement \
+ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */
#endif
#ifndef Tcl_Seek
-#define Tcl_Seek(chan, offset, mode) \
- (tclStubsPtr->tcl_Seek)(chan, offset, mode) /* 220 */
+#define Tcl_Seek \
+ (tclStubsPtr->tcl_Seek) /* 220 */
#endif
#ifndef Tcl_ServiceAll
-#define Tcl_ServiceAll() \
- (tclStubsPtr->tcl_ServiceAll)() /* 221 */
+#define Tcl_ServiceAll \
+ (tclStubsPtr->tcl_ServiceAll) /* 221 */
#endif
#ifndef Tcl_ServiceEvent
-#define Tcl_ServiceEvent(flags) \
- (tclStubsPtr->tcl_ServiceEvent)(flags) /* 222 */
+#define Tcl_ServiceEvent \
+ (tclStubsPtr->tcl_ServiceEvent) /* 222 */
#endif
#ifndef Tcl_SetAssocData
-#define Tcl_SetAssocData(interp, name, proc, clientData) \
- (tclStubsPtr->tcl_SetAssocData)(interp, name, proc, clientData) /* 223 */
+#define Tcl_SetAssocData \
+ (tclStubsPtr->tcl_SetAssocData) /* 223 */
#endif
#ifndef Tcl_SetChannelBufferSize
-#define Tcl_SetChannelBufferSize(chan, sz) \
- (tclStubsPtr->tcl_SetChannelBufferSize)(chan, sz) /* 224 */
+#define Tcl_SetChannelBufferSize \
+ (tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
#endif
#ifndef Tcl_SetChannelOption
-#define Tcl_SetChannelOption(interp, chan, optionName, newValue) \
- (tclStubsPtr->tcl_SetChannelOption)(interp, chan, optionName, newValue) /* 225 */
+#define Tcl_SetChannelOption \
+ (tclStubsPtr->tcl_SetChannelOption) /* 225 */
#endif
#ifndef Tcl_SetCommandInfo
-#define Tcl_SetCommandInfo(interp, cmdName, infoPtr) \
- (tclStubsPtr->tcl_SetCommandInfo)(interp, cmdName, infoPtr) /* 226 */
+#define Tcl_SetCommandInfo \
+ (tclStubsPtr->tcl_SetCommandInfo) /* 226 */
#endif
#ifndef Tcl_SetErrno
-#define Tcl_SetErrno(err) \
- (tclStubsPtr->tcl_SetErrno)(err) /* 227 */
+#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(timePtr) \
- (tclStubsPtr->tcl_SetMaxBlockTime)(timePtr) /* 229 */
+#define Tcl_SetMaxBlockTime \
+ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */
#endif
#ifndef Tcl_SetPanicProc
-#define Tcl_SetPanicProc(panicProc) \
- (tclStubsPtr->tcl_SetPanicProc)(panicProc) /* 230 */
+#define Tcl_SetPanicProc \
+ (tclStubsPtr->tcl_SetPanicProc) /* 230 */
#endif
#ifndef Tcl_SetRecursionLimit
-#define Tcl_SetRecursionLimit(interp, depth) \
- (tclStubsPtr->tcl_SetRecursionLimit)(interp, depth) /* 231 */
+#define Tcl_SetRecursionLimit \
+ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */
#endif
#ifndef Tcl_SetResult
-#define Tcl_SetResult(interp, string, freeProc) \
- (tclStubsPtr->tcl_SetResult)(interp, string, freeProc) /* 232 */
+#define Tcl_SetResult \
+ (tclStubsPtr->tcl_SetResult) /* 232 */
#endif
#ifndef Tcl_SetServiceMode
-#define Tcl_SetServiceMode(mode) \
- (tclStubsPtr->tcl_SetServiceMode)(mode) /* 233 */
+#define Tcl_SetServiceMode \
+ (tclStubsPtr->tcl_SetServiceMode) /* 233 */
#endif
#ifndef Tcl_SetObjErrorCode
-#define Tcl_SetObjErrorCode(interp, errorObjPtr) \
- (tclStubsPtr->tcl_SetObjErrorCode)(interp, errorObjPtr) /* 234 */
+#define Tcl_SetObjErrorCode \
+ (tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
#endif
#ifndef Tcl_SetObjResult
-#define Tcl_SetObjResult(interp, resultObjPtr) \
- (tclStubsPtr->tcl_SetObjResult)(interp, resultObjPtr) /* 235 */
+#define Tcl_SetObjResult \
+ (tclStubsPtr->tcl_SetObjResult) /* 235 */
#endif
#ifndef Tcl_SetStdChannel
-#define Tcl_SetStdChannel(channel, type) \
- (tclStubsPtr->tcl_SetStdChannel)(channel, type) /* 236 */
+#define Tcl_SetStdChannel \
+ (tclStubsPtr->tcl_SetStdChannel) /* 236 */
#endif
#ifndef Tcl_SetVar
-#define Tcl_SetVar(interp, varName, newValue, flags) \
- (tclStubsPtr->tcl_SetVar)(interp, varName, newValue, flags) /* 237 */
+#define Tcl_SetVar \
+ (tclStubsPtr->tcl_SetVar) /* 237 */
#endif
#ifndef Tcl_SetVar2
-#define Tcl_SetVar2(interp, part1, part2, newValue, flags) \
- (tclStubsPtr->tcl_SetVar2)(interp, part1, part2, newValue, flags) /* 238 */
+#define Tcl_SetVar2 \
+ (tclStubsPtr->tcl_SetVar2) /* 238 */
#endif
#ifndef Tcl_SignalId
-#define Tcl_SignalId(sig) \
- (tclStubsPtr->tcl_SignalId)(sig) /* 239 */
+#define Tcl_SignalId \
+ (tclStubsPtr->tcl_SignalId) /* 239 */
#endif
#ifndef Tcl_SignalMsg
-#define Tcl_SignalMsg(sig) \
- (tclStubsPtr->tcl_SignalMsg)(sig) /* 240 */
+#define Tcl_SignalMsg \
+ (tclStubsPtr->tcl_SignalMsg) /* 240 */
#endif
#ifndef Tcl_SourceRCFile
-#define Tcl_SourceRCFile(interp) \
- (tclStubsPtr->tcl_SourceRCFile)(interp) /* 241 */
+#define Tcl_SourceRCFile \
+ (tclStubsPtr->tcl_SourceRCFile) /* 241 */
#endif
#ifndef Tcl_SplitList
-#define Tcl_SplitList(interp, list, argcPtr, argvPtr) \
- (tclStubsPtr->tcl_SplitList)(interp, list, argcPtr, argvPtr) /* 242 */
+#define Tcl_SplitList \
+ (tclStubsPtr->tcl_SplitList) /* 242 */
#endif
#ifndef Tcl_SplitPath
-#define Tcl_SplitPath(path, argcPtr, argvPtr) \
- (tclStubsPtr->tcl_SplitPath)(path, argcPtr, argvPtr) /* 243 */
+#define Tcl_SplitPath \
+ (tclStubsPtr->tcl_SplitPath) /* 243 */
#endif
#ifndef Tcl_StaticPackage
-#define Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc) \
- (tclStubsPtr->tcl_StaticPackage)(interp, pkgName, initProc, safeInitProc) /* 244 */
+#define Tcl_StaticPackage \
+ (tclStubsPtr->tcl_StaticPackage) /* 244 */
#endif
#ifndef Tcl_StringMatch
-#define Tcl_StringMatch(string, pattern) \
- (tclStubsPtr->tcl_StringMatch)(string, pattern) /* 245 */
+#define Tcl_StringMatch \
+ (tclStubsPtr->tcl_StringMatch) /* 245 */
#endif
#ifndef Tcl_Tell
-#define Tcl_Tell(chan) \
- (tclStubsPtr->tcl_Tell)(chan) /* 246 */
+#define Tcl_Tell \
+ (tclStubsPtr->tcl_Tell) /* 246 */
#endif
#ifndef Tcl_TraceVar
-#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
- (tclStubsPtr->tcl_TraceVar)(interp, varName, flags, proc, clientData) /* 247 */
+#define Tcl_TraceVar \
+ (tclStubsPtr->tcl_TraceVar) /* 247 */
#endif
#ifndef Tcl_TraceVar2
-#define Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) \
- (tclStubsPtr->tcl_TraceVar2)(interp, part1, part2, flags, proc, clientData) /* 248 */
+#define Tcl_TraceVar2 \
+ (tclStubsPtr->tcl_TraceVar2) /* 248 */
#endif
#ifndef Tcl_TranslateFileName
-#define Tcl_TranslateFileName(interp, name, bufferPtr) \
- (tclStubsPtr->tcl_TranslateFileName)(interp, name, bufferPtr) /* 249 */
+#define Tcl_TranslateFileName \
+ (tclStubsPtr->tcl_TranslateFileName) /* 249 */
#endif
#ifndef Tcl_Ungets
-#define Tcl_Ungets(chan, str, len, atHead) \
- (tclStubsPtr->tcl_Ungets)(chan, str, len, atHead) /* 250 */
+#define Tcl_Ungets \
+ (tclStubsPtr->tcl_Ungets) /* 250 */
#endif
#ifndef Tcl_UnlinkVar
-#define Tcl_UnlinkVar(interp, varName) \
- (tclStubsPtr->tcl_UnlinkVar)(interp, varName) /* 251 */
+#define Tcl_UnlinkVar \
+ (tclStubsPtr->tcl_UnlinkVar) /* 251 */
#endif
#ifndef Tcl_UnregisterChannel
-#define Tcl_UnregisterChannel(interp, chan) \
- (tclStubsPtr->tcl_UnregisterChannel)(interp, chan) /* 252 */
+#define Tcl_UnregisterChannel \
+ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */
#endif
#ifndef Tcl_UnsetVar
-#define Tcl_UnsetVar(interp, varName, flags) \
- (tclStubsPtr->tcl_UnsetVar)(interp, varName, flags) /* 253 */
+#define Tcl_UnsetVar \
+ (tclStubsPtr->tcl_UnsetVar) /* 253 */
#endif
#ifndef Tcl_UnsetVar2
-#define Tcl_UnsetVar2(interp, part1, part2, flags) \
- (tclStubsPtr->tcl_UnsetVar2)(interp, part1, part2, flags) /* 254 */
+#define Tcl_UnsetVar2 \
+ (tclStubsPtr->tcl_UnsetVar2) /* 254 */
#endif
#ifndef Tcl_UntraceVar
-#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
- (tclStubsPtr->tcl_UntraceVar)(interp, varName, flags, proc, clientData) /* 255 */
+#define Tcl_UntraceVar \
+ (tclStubsPtr->tcl_UntraceVar) /* 255 */
#endif
#ifndef Tcl_UntraceVar2
-#define Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) \
- (tclStubsPtr->tcl_UntraceVar2)(interp, part1, part2, flags, proc, clientData) /* 256 */
+#define Tcl_UntraceVar2 \
+ (tclStubsPtr->tcl_UntraceVar2) /* 256 */
#endif
#ifndef Tcl_UpdateLinkedVar
-#define Tcl_UpdateLinkedVar(interp, varName) \
- (tclStubsPtr->tcl_UpdateLinkedVar)(interp, varName) /* 257 */
+#define Tcl_UpdateLinkedVar \
+ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
#endif
#ifndef Tcl_UpVar
-#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
- (tclStubsPtr->tcl_UpVar)(interp, frameName, varName, localName, flags) /* 258 */
+#define Tcl_UpVar \
+ (tclStubsPtr->tcl_UpVar) /* 258 */
#endif
#ifndef Tcl_UpVar2
-#define Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) \
- (tclStubsPtr->tcl_UpVar2)(interp, frameName, part1, part2, localName, flags) /* 259 */
+#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(interp, varName, flags, procPtr, prevClientData) \
- (tclStubsPtr->tcl_VarTraceInfo)(interp, varName, flags, procPtr, prevClientData) /* 261 */
+#define Tcl_VarTraceInfo \
+ (tclStubsPtr->tcl_VarTraceInfo) /* 261 */
#endif
#ifndef Tcl_VarTraceInfo2
-#define Tcl_VarTraceInfo2(interp, part1, part2, flags, procPtr, prevClientData) \
- (tclStubsPtr->tcl_VarTraceInfo2)(interp, part1, part2, flags, procPtr, prevClientData) /* 262 */
+#define Tcl_VarTraceInfo2 \
+ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
#endif
#ifndef Tcl_Write
-#define Tcl_Write(chan, s, slen) \
- (tclStubsPtr->tcl_Write)(chan, s, slen) /* 263 */
+#define Tcl_Write \
+ (tclStubsPtr->tcl_Write) /* 263 */
#endif
#ifndef Tcl_WrongNumArgs
-#define Tcl_WrongNumArgs(interp, objc, objv, message) \
- (tclStubsPtr->tcl_WrongNumArgs)(interp, objc, objv, message) /* 264 */
+#define Tcl_WrongNumArgs \
+ (tclStubsPtr->tcl_WrongNumArgs) /* 264 */
#endif
#ifndef Tcl_DumpActiveMemory
-#define Tcl_DumpActiveMemory(fileName) \
- (tclStubsPtr->tcl_DumpActiveMemory)(fileName) /* 265 */
+#define Tcl_DumpActiveMemory \
+ (tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
#endif
#ifndef Tcl_ValidateAllMemory
-#define Tcl_ValidateAllMemory(file, line) \
- (tclStubsPtr->tcl_ValidateAllMemory)(file, line) /* 266 */
+#define Tcl_ValidateAllMemory \
+ (tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
#endif
#ifndef Tcl_AppendResultVA
-#define Tcl_AppendResultVA(interp, argList) \
- (tclStubsPtr->tcl_AppendResultVA)(interp, argList) /* 267 */
+#define Tcl_AppendResultVA \
+ (tclStubsPtr->tcl_AppendResultVA) /* 267 */
#endif
#ifndef Tcl_AppendStringsToObjVA
-#define Tcl_AppendStringsToObjVA(objPtr, argList) \
- (tclStubsPtr->tcl_AppendStringsToObjVA)(objPtr, argList) /* 268 */
+#define Tcl_AppendStringsToObjVA \
+ (tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
#endif
#ifndef Tcl_HashStats
-#define Tcl_HashStats(tablePtr) \
- (tclStubsPtr->tcl_HashStats)(tablePtr) /* 269 */
+#define Tcl_HashStats \
+ (tclStubsPtr->tcl_HashStats) /* 269 */
#endif
#ifndef Tcl_ParseVar
-#define Tcl_ParseVar(interp, string, termPtr) \
- (tclStubsPtr->tcl_ParseVar)(interp, string, termPtr) /* 270 */
+#define Tcl_ParseVar \
+ (tclStubsPtr->tcl_ParseVar) /* 270 */
#endif
#ifndef Tcl_PkgPresent
-#define Tcl_PkgPresent(interp, name, version, exact) \
- (tclStubsPtr->tcl_PkgPresent)(interp, name, version, exact) /* 271 */
+#define Tcl_PkgPresent \
+ (tclStubsPtr->tcl_PkgPresent) /* 271 */
#endif
#ifndef Tcl_PkgPresentEx
-#define Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr) \
- (tclStubsPtr->tcl_PkgPresentEx)(interp, name, version, exact, clientDataPtr) /* 272 */
+#define Tcl_PkgPresentEx \
+ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */
#endif
#ifndef Tcl_PkgProvide
-#define Tcl_PkgProvide(interp, name, version) \
- (tclStubsPtr->tcl_PkgProvide)(interp, name, version) /* 273 */
+#define Tcl_PkgProvide \
+ (tclStubsPtr->tcl_PkgProvide) /* 273 */
#endif
#ifndef Tcl_PkgRequire
-#define Tcl_PkgRequire(interp, name, version, exact) \
- (tclStubsPtr->tcl_PkgRequire)(interp, name, version, exact) /* 274 */
+#define Tcl_PkgRequire \
+ (tclStubsPtr->tcl_PkgRequire) /* 274 */
#endif
#ifndef Tcl_SetErrorCodeVA
-#define Tcl_SetErrorCodeVA(interp, argList) \
- (tclStubsPtr->tcl_SetErrorCodeVA)(interp, argList) /* 275 */
+#define Tcl_SetErrorCodeVA \
+ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
#endif
#ifndef Tcl_VarEvalVA
-#define Tcl_VarEvalVA(interp, argList) \
- (tclStubsPtr->tcl_VarEvalVA)(interp, argList) /* 276 */
+#define Tcl_VarEvalVA \
+ (tclStubsPtr->tcl_VarEvalVA) /* 276 */
#endif
#ifndef Tcl_WaitPid
-#define Tcl_WaitPid(pid, statPtr, options) \
- (tclStubsPtr->tcl_WaitPid)(pid, statPtr, options) /* 277 */
+#define Tcl_WaitPid \
+ (tclStubsPtr->tcl_WaitPid) /* 277 */
#endif
-#ifndef panicVA
-#define panicVA(format, argList) \
- (tclStubsPtr->panicVA)(format, argList) /* 278 */
+#ifndef Tcl_PanicVA
+#define Tcl_PanicVA \
+ (tclStubsPtr->tcl_PanicVA) /* 278 */
#endif
#ifndef Tcl_GetVersion
-#define Tcl_GetVersion(major, minor, patchLevel, type) \
- (tclStubsPtr->tcl_GetVersion)(major, minor, patchLevel, type) /* 279 */
+#define Tcl_GetVersion \
+ (tclStubsPtr->tcl_GetVersion) /* 279 */
+#endif
+#ifndef Tcl_InitMemory
+#define Tcl_InitMemory \
+ (tclStubsPtr->tcl_InitMemory) /* 280 */
+#endif
+/* Slot 281 is reserved */
+/* Slot 282 is reserved */
+/* Slot 283 is reserved */
+/* 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
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
new file mode 100644
index 0000000..40ded74
--- /dev/null
+++ b/generic/tclEncoding.c
@@ -0,0 +1,2685 @@
+/*
+ * 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: tclEncoding.c,v 1.2 1999/04/16 00:46:45 stanton Exp $
+ */
+
+#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;
+
+/*
+ * 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);
+ 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, 0) == 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 = strlen;
+ } else {
+ encodingPtr->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;
+}
+
+
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 52d68ae..4e5854e 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -7,34 +7,18 @@
* 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.
*
- * RCS: @(#) $Id: tclEnv.c,v 1.3 1999/02/02 23:01:59 stanton Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.4 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
-/*
- * 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;
-
-static EnvInterp *firstInterpPtr = NULL;
- /* First in list of all managed interpreters,
- * or NULL if none. */
+TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ */
static int cacheSize = 0; /* Number of env strings in environCache. */
static char **environCache = NULL;
@@ -56,13 +40,12 @@ static int environSize = 0; /* Non-zero means that the environ array was
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,
CONST char *value));
void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
+
/*
*----------------------------------------------------------------------
@@ -80,7 +63,7 @@ void TclUnsetEnv _ANSI_ARGS_((CONST char *name));
* 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.
*
@@ -92,73 +75,59 @@ 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
+ Tcl_DString envString;
+ char *p1, *p2;
+ int i;
/*
- * Next, initialize the DString we are going to use for copying
- * the names of the environment variables.
+ * 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.
*/
-
- Tcl_DStringInit(&ds);
- /*
- * Next, add the interpreter to the list of those that we manage.
- */
-
- eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
- eiPtr->interp = interp;
- eiPtr->nextPtr = firstInterpPtr;
- firstInterpPtr = eiPtr;
-
- /*
- * 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.
- */
-
- (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);
}
/*
@@ -177,8 +146,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.
*
*----------------------------------------------------------------------
*/
@@ -186,47 +154,45 @@ 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 *)));
memcpy((VOID *) newEnviron, (VOID *) environ,
length*sizeof(char *));
if (environSize != 0) {
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
@@ -235,47 +201,63 @@ 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);
+ ckfree(p);
+
+#ifdef USE_PUTENV
/*
* Update the system environment.
*/
-#ifdef USE_PUTENV
- putenv(p);
+ putenv(p2);
+ index = TclpFindVariable(name, &length);
#else
- environ[index] = p;
-#endif
-
/*
- * Replace the old value with the new value in the cache.
+ * Copy the native string to heap memory.
*/
-
- ReplaceString(oldValue, p);
+
+ p = (char *) ckalloc((unsigned) (strlen(p2) + 1));
+ strcpy(p, p2);
+ environ[index] = p;
+#endif
/*
- * 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.
*/
- for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
- (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
- (char *) value, TCL_GLOBAL_ONLY);
+ if (environ[index] != p) {
+ Tcl_DStringFree(&envString);
+ } else {
+ ReplaceString(oldValue, p);
}
+
+ Tcl_MutexUnlock(&envMutex);
}
/*
@@ -304,8 +286,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;
@@ -314,23 +297,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;
}
@@ -356,24 +340,19 @@ 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;
#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
@@ -381,6 +360,7 @@ TclUnsetEnv(name)
*/
if (index == -1) {
+ Tcl_MutexUnlock(&envMutex);
return;
}
/*
@@ -399,8 +379,23 @@ TclUnsetEnv(name)
memcpy((VOID *) string, (VOID *) name, (size_t) length);
string[length] = '=';
string[length+1] = '\0';
- putenv(string);
+
+ Tcl_UtfToExternalDString(NULL, string, -1, &envString);
ckfree(string);
+ string = Tcl_DStringValue(&envString);
+ putenv(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) {
+ Tcl_DStringFree(&envString);
+ } else {
+ ReplaceString(oldValue, string);
+ }
#else
for (envPtr = environ+index+1; ; envPtr++) {
envPtr[-1] = *envPtr;
@@ -408,34 +403,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.
@@ -444,23 +430,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;
}
/*
@@ -469,9 +468,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.
@@ -492,38 +490,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;
}
@@ -532,9 +516,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);
}
@@ -603,7 +610,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) {
@@ -621,50 +628,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
@@ -700,3 +663,7 @@ TclFinalizeEnvironment()
#endif
}
}
+
+
+
+
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 162af15..7499577 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -6,12 +6,12 @@
* 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.
*
- * RCS: @(#) $Id: tclEvent.c,v 1.3 1998/09/14 18:39:58 stanton Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.4 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -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,38 @@ 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;
+static int encodingsInitialized = 0;
+
+static Tcl_Obj *tclLibraryPath = NULL;
+
+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. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
/*
* Prototypes for procedures referenced only in this file:
@@ -127,6 +139,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 +151,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 +219,6 @@ HandleBgErrors(clientData)
ClientData clientData; /* Pointer to ErrAssocData structure. */
{
Tcl_Interp *interp;
- char *command;
char *argv[2];
int code;
BgError *errPtr;
@@ -237,11 +249,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 +267,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 +283,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 +411,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 +443,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)
@@ -455,6 +453,82 @@ Tcl_DeleteExitHandler(proc, clientData)
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
+ Tcl_MutexUnlock(&exitMutex);
+ ckfree((char *) exitPtr);
+ 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 +558,242 @@ 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. */
+{
+ Tcl_MutexLock(&exitMutex);
+ if (pathPtr != NULL) {
+ Tcl_IncrRefCount(pathPtr);
+ }
+ if (tclLibraryPath != NULL) {
+ Tcl_DecrRefCount(tclLibraryPath);
+ }
+ tclLibraryPath = pathPtr;
+ Tcl_MutexUnlock(&exitMutex);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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()
+{
+ return 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();
+#endif
+#ifdef TCL_MEM_DEBUG
+ TclInitDbCkalloc();
#endif
- TclPlatformExit(status);
+
+ TclpInitPlatform();
+ TclInitObjSubsystem();
+ TclInitIOSubsystem();
+ TclInitEncodingSubsystem();
+ TclInitNamespaceSubsystem();
+ }
+ 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();
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * 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 sting back to 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();
+ }
}
/*
@@ -497,16 +801,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 +819,150 @@ void
Tcl_Finalize()
{
ExitHandler *exitPtr;
+
+ TclpInitLock();
+ if (subsystemsInitialized != 0) {
+ subsystemsInitialized = 0;
+ encodingsInitialized = 0;
+
+ /*
+ * Invoke exit handlers first.
+ */
+
+ 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 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.
+ */
- /*
- * Invoke exit handler first.
- */
+ 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 (tclLibraryPath != NULL) {
+ Tcl_DecrRefCount(tclLibraryPath);
+ tclLibraryPath = NULL;
+ }
+ 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();
- 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.
+ * There shouldn't be any malloc'ed memory after this.
*/
- firstExitPtr = exitPtr->nextPtr;
- (*exitPtr->proc)(exitPtr->clientData);
- ckfree((char *) exitPtr);
+ 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 +984,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 +1007,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 +1031,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 +1042,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 +1067,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 +1083,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 */
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index b899085..4378d34 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.5 1998/11/19 20:10:51 stanton Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.6 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -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)); \
+ 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,%ld (%u) ", iPtr->numLevels, \
- stackTop, (tclObjsAlloced - tclObjsFreed), \
- (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); \
- }
-#else /* not TCL_COMPILE_STATS */
-#define TRACE(a) \
- if (traceInstructions) { \
- fprintf(stdout, "%d: %d (%u) ", iPtr->numLevels, stackTop, \
- (unsigned int)(pc - codePtr->codeStart)); \
- 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)); \
- printf a; \
- bytes = Tcl_GetStringFromObj((objPtr), &length); \
- TclPrintSource(stdout, bytes, TclMin(length, 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,34 @@ 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
/*
* Table describing the built-in math functions. Entries in this table are
@@ -356,7 +310,7 @@ Tcl_ObjType tclCmdNameType = {
"cmdName", /* name */
FreeCmdNameInternalRep, /* freeIntRepProc */
DupCmdNameInternalRep, /* dupIntRepProc */
- UpdateStringOfCmdName, /* updateStringProc */
+ (Tcl_UpdateStringProc *) NULL, /* updateStringProc */
SetCmdNameFromAny /* setFromAnyProc */
};
@@ -388,28 +342,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 +385,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 +430,7 @@ TclDeleteExecEnv(eePtr)
/*
*----------------------------------------------------------------------
*
- * TclFinalizeExecEnv --
+ * TclFinalizeExecution --
*
* Finalizes the execution environment setup so that it can be
* later reinitialized.
@@ -502,9 +446,11 @@ TclDeleteExecEnv(eePtr)
*/
void
-TclFinalizeExecEnv()
+TclFinalizeExecution()
{
+ Tcl_MutexLock(&execMutex);
execInitialized = 0;
+ Tcl_MutexUnlock(&execMutex);
TclFinalizeAuxDataTypeTable();
}
@@ -536,9 +482,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 +526,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 +541,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 +553,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 +576,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 +591,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 +600,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 +624,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 +676,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 +693,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 +705,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 +726,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 +750,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 +814,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 +863,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 +881,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 +896,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 +939,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 +949,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 +989,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 +1002,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 +1010,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 +1027,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 +1040,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:
- opnd = TclGetUInt1AtPtr(pc+1);
- pcAdjustment = 2;
-
- doLoadScalar:
+#ifdef TCL_COMPILE_DEBUG
+ opnd = TclGetInt1AtPtr(pc+1);
+ 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();
+ valuePtr = TclGetIndexedScalar(interp, TclGetInt1AtPtr(pc+1),
+ /*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 +1129,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 +1146,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 +1198,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 +1256,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 +1278,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 +1305,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 +1332,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 +1343,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 +1399,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 +1413,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 +1422,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 +1435,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 +1450,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 +1479,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 +1521,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 +1529,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 +1541,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 +1601,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 +1641,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 +1682,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 +1694,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 +1708,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 +1733,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. */
@@ -1891,7 +1780,7 @@ TclExecuteByteCode(interp, codePtr)
if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
s1 = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s1)) { /* FAILS IF NULLS */
+ if (TclLooksLikeInt(s1, length)) {
(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
} else {
@@ -1902,7 +1791,7 @@ TclExecuteByteCode(interp, codePtr)
}
if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
s2 = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s2)) { /* FAILS IF NULLS */
+ if (TclLooksLikeInt(s2, length)) {
(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
value2Ptr, &i2);
} else {
@@ -1916,13 +1805,12 @@ TclExecuteByteCode(interp, codePtr)
|| ((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 +1846,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 +1872,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 +1900,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 +1935,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 +1951,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 +1971,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 +2023,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 +2058,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 +2077,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 +2091,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 +2110,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 +2132,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 +2144,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 +2158,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 +2170,7 @@ TclExecuteByteCode(interp, codePtr)
/*
* Do integer arithmetic.
*/
- switch (opCode) {
+ switch (*pc) {
case INST_ADD:
iResult = i + i2;
break;
@@ -2290,8 +2188,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 +2214,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 +2243,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 +2256,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,9 +2307,10 @@ 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 */
+ 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 {
@@ -2398,10 +2318,9 @@ 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);
Tcl_DecrRefCount(valuePtr);
goto checkForCatch;
}
@@ -2415,12 +2334,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 +2347,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 +2358,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 +2371,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 +2395,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 +2406,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 +2414,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 +2427,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 +2435,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 +2459,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,12 +2488,13 @@ 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 */
+ if ((tPtr != &tclIntType) && ((tPtr != &tclDoubleType)
+ || (valuePtr->bytes != NULL))) {
+ s = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL,
valuePtr, &i);
} else {
@@ -2617,31 +2533,29 @@ TclExecuteByteCode(interp, codePtr)
Tcl_IncrRefCount(objPtr);
TclDecrRefCount(valuePtr);
valuePtr = objPtr;
+ stackPtr[stackTop] = valuePtr;
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 +2570,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 +2602,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 +2639,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 +2652,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 +2666,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 +2719,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 +2734,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 +2761,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 +2779,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 +2825,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 +2856,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 +2891,7 @@ TclExecuteByteCode(interp, codePtr)
#undef STATIC_CATCH_STACK_SIZE
}
+#ifdef TCL_COMPILE_DEBUG
/*
*----------------------------------------------------------------------
*
@@ -2999,45 +2916,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 +2976,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 +3033,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,23 +3045,39 @@ 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;
+ int isDouble;
+
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 {
+ isDouble = 1;
+ 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) {
+ isDouble = 0;
+ }
+ }
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
- ((opndPtr->typePtr == &tclDoubleType) ?
- "floating-point value" : "non-numeric string"),
+ (isDouble? "floating-point value" : "non-numeric string"),
" as operand of \"", operatorStrings[opCode - INST_LOR],
"\"", (char *) NULL);
}
@@ -3192,7 +3124,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 +3154,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 +3276,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 +3287,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,37 +3298,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;
- int numRanges = codePtr->numExcRanges;
+ int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
- int codeOffset = (pc - codePtr->codeStart);
+ int pcOffset = (pc - codePtr->codeStart);
register int i, level;
if (numRanges == 0) {
return NULL;
}
- rangeArrayPtr = codePtr->excRangeArrayPtr;
+ rangeArrayPtr = codePtr->exceptArrayPtr;
- for (level = codePtr->maxExcRangeDepth; level >= 0; level--) {
+ 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;
@@ -3482,6 +3343,36 @@ 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 */
+
+/*
+ *----------------------------------------------------------------------
+ *
* Math Functions --
*
* This page contains the procedures that implement all of the
@@ -3508,13 +3399,13 @@ 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 length, result;
double (*func) _ANSI_ARGS_((double)) =
(double (*)_ANSI_ARGS_((double))) clientData;
@@ -3522,7 +3413,8 @@ ExprUnaryFunc(interp, eePtr, clientData)
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3537,10 +3429,10 @@ ExprUnaryFunc(interp, eePtr, clientData)
d = (double) 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);
+ } else {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
d = (double) valuePtr->internalRep.longValue;
} else {
@@ -3588,14 +3480,14 @@ 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 length, result;
double (*func) _ANSI_ARGS_((double, double))
= (double (*)_ANSI_ARGS_((double, double))) clientData;
@@ -3603,7 +3495,8 @@ ExprBinaryFunc(interp, eePtr, clientData)
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3619,9 +3512,9 @@ ExprBinaryFunc(interp, eePtr, clientData)
d1 = (double) valuePtr->internalRep.longValue;
} else if (tPtr == &tclDoubleType) {
d1 = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- 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);
d1 = (double) valuePtr->internalRep.longValue;
} else {
@@ -3641,9 +3534,9 @@ ExprBinaryFunc(interp, eePtr, clientData)
d2 = value2Ptr->internalRep.longValue;
} else if (tPtr == &tclDoubleType) {
d2 = value2Ptr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- 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);
d2 = (double) value2Ptr->internalRep.longValue;
} else {
@@ -3687,18 +3580,19 @@ 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 length, result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3712,10 +3606,10 @@ ExprAbsFunc(interp, eePtr, clientData)
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);
+ } else {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
@@ -3781,17 +3675,18 @@ 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 length, result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3803,10 +3698,10 @@ ExprDoubleFunc(interp, eePtr, clientData)
dResult = (double) valuePtr->internalRep.longValue;
} else if (valuePtr->typePtr == &tclDoubleType) {
dResult = valuePtr->internalRep.doubleValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+ } else {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
dResult = (double) valuePtr->internalRep.longValue;
} else {
@@ -3845,19 +3740,20 @@ 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 length, result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -3871,10 +3767,10 @@ ExprIntFunc(interp, eePtr, clientData)
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);
+ } else {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
@@ -3938,7 +3834,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;
@@ -4026,19 +3922,20 @@ 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 length, result;
/*
* Set stackPtr and stackTop from eePtr.
*/
-
+
+ result = TCL_OK;
CACHE_STACK_INFO();
/*
@@ -4052,10 +3949,10 @@ ExprRoundFunc(interp, eePtr, clientData)
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);
+ } else {
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, valuePtr, &d);
@@ -4122,13 +4019,13 @@ 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;
+ int isDouble, result;
/*
* Set stackPtr and stackTop from eePtr.
@@ -4146,12 +4043,27 @@ ExprSrandFunc(interp, eePtr, clientData)
if (tPtr == &tclIntType) {
i = valuePtr->internalRep.longValue;
- } else { /* FAILS IF STRING REP HAS NULLS */
+ } else {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
if (result != TCL_OK) {
+ /*
+ * See if the operand can be interpreted as a double in order to
+ * improve the error message.
+ */
+
+ isDouble = 1;
+ if (valuePtr->typePtr != &tclDoubleType) {
+ char *s = Tcl_GetString(valuePtr);
+ double d;
+
+ if (Tcl_GetDouble((Tcl_Interp *) NULL, s, &d) != TCL_OK) {
+ isDouble = 0;
+ }
+ }
+
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ",
- ((tPtr == &tclDoubleType)? "floating-point value" : "non-numeric string"),
+ (isDouble? "floating-point value":"non-numeric string"),
" as argument to srand", (char *) NULL);
Tcl_DecrRefCount(valuePtr);
DECACHE_STACK_INFO();
@@ -4212,7 +4124,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;
@@ -4223,10 +4135,11 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
Tcl_ObjType *tPtr;
long i;
double d;
- int j, k, result;
-
+ int j, k, length, result;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
Tcl_ResetResult(interp);
-
+
/*
* Set stackPtr and stackTop from eePtr.
*/
@@ -4235,10 +4148,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),
@@ -4271,12 +4183,11 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
} else {
/*
* Try to convert to int first then double.
- * FAILS IF STRING REP HAS NULLS.
*/
- char *s = Tcl_GetStringFromObj(valuePtr, (int *) NULL);
+ char *s = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s)) {
+ if (TclLooksLikeInt(s, length)) {
result = Tcl_GetLongFromObj((Tcl_Interp *) NULL, valuePtr, &i);
} else {
result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
@@ -4318,10 +4229,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;
}
@@ -4332,7 +4243,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
i = (stackTop - (objc-1));
while (i <= stackTop) {
- valuePtr = stackPtr[i].o;
+ valuePtr = stackPtr[i];
Tcl_DecrRefCount(valuePtr);
i++;
}
@@ -4404,8 +4315,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);
@@ -4413,6 +4324,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
/*
*----------------------------------------------------------------------
@@ -4471,120 +4406,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));
-
- 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);
+ 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, "\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 */
@@ -4680,11 +4850,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;
}
/*
@@ -4812,7 +5043,7 @@ SetCmdNameFromAny(interp, objPtr)
name = objPtr->bytes;
if (name == NULL) {
- name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ name = Tcl_GetString(objPtr);
}
/*
@@ -4867,34 +5098,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
/*
*----------------------------------------------------------------------
@@ -4922,7 +5125,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];
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 1d4ae62..b69358b 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -4,12 +4,12 @@
* 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.
*
- * RCS: @(#) $Id: tclFCmd.c,v 1.3 1998/09/14 18:39:59 stanton Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.4 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -141,12 +141,12 @@ FileCopyRename(interp, argc, argv, copyFlag)
result = TCL_OK;
/*
- * Call TclStat() so that if target is a symlink that points to a
+ * Call TclpStat() so that if target is a symlink that points to a
* directory we will put the sources in that directory instead of
* overwriting the symlink.
*/
- if ((TclStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
+ if ((TclpStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
if ((argc - i) > 2) {
errno = ENOTDIR;
Tcl_PosixError(interp);
@@ -253,12 +253,12 @@ TclFileMakeDirsCmd(interp, argc, argv)
char *target = Tcl_JoinPath(j + 1, pargv, &targetBuffer);
/*
- * Call TclStat() so that if target is a symlink that points
+ * Call TclpStat() so that if target is a symlink that points
* to a directory we will create subdirectories in that
* directory.
*/
- if (TclStat(target, &statBuf) == 0) {
+ if (TclpStat(target, &statBuf) == 0) {
if (!S_ISDIR(statBuf.st_mode)) {
errno = EEXIST;
errfile = target;
@@ -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
@@ -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/generic/tclFileName.c b/generic/tclFileName.c
index 7be9c0e..06e83a3 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -4,12 +4,13 @@
* 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.
*
- * RCS: @(#) $Id: tclFileName.c,v 1.5 1999/03/10 05:52:48 stanton Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.6 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -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,13 @@ static int initialized = 0;
* for use in filename matching.
*/
-static regexp *winRootPatternPtr = NULL;
-static regexp *macRootPatternPtr = NULL;
+typedef struct ThreadSpecificData {
+ int initialized;
+ Tcl_Obj *winRootPatternPtr;
+ Tcl_Obj *macRootPatternPtr;
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
/*
* The following variable is set in the TclPlatformInit call to one
@@ -59,22 +58,51 @@ TclPlatformType tclPlatform = TCL_PLATFORM_UNIX;
*/
static char * DoTildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
- char *user, Tcl_DString *resultPtr));
-static char * ExtractWinRoot _ANSI_ARGS_((char *path,
+ CONST char *user, Tcl_DString *resultPtr));
+static CONST char * ExtractWinRoot _ANSI_ARGS_((CONST char *path,
Tcl_DString *resultPtr, int offset));
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->winRootPatternPtr = Tcl_NewStringObj(WIN_ROOT_PATTERN, -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 +121,10 @@ 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->winRootPatternPtr);
+ Tcl_DecrRefCount(tsdPtr->macRootPatternPtr);
+ tsdPtr->initialized = 0;
}
/*
@@ -124,55 +147,59 @@ FileNameCleanup(clientData)
*----------------------------------------------------------------------
*/
-static char *
+static CONST char *
ExtractWinRoot(path, resultPtr, offset)
- char *path; /* Path to parse. */
+ CONST char *path; /* Path to parse. */
Tcl_DString *resultPtr; /* Buffer to hold result. */
int offset; /* Offset in buffer where result should be
* stored. */
{
int length;
+ Tcl_RegExp re;
+ char *dummy, *tail, *drive, *hostStart, *hostEnd, *shareStart,
+ *shareEnd, *lastSlash;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* 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;
- }
- }
+ FileNameInit();
+
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr, REG_ADVANCED);
/*
* Match the root portion of a Windows path name.
*/
- if (!TclRegExec(winRootPatternPtr, path, path)) {
+ if (!Tcl_RegExpExec(NULL, re, path, path)) {
return path;
}
Tcl_DStringSetLength(resultPtr, offset);
- if (winRootPatternPtr->startp[2] != NULL) {
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[2], 2);
- if (winRootPatternPtr->startp[6] != NULL) {
+ Tcl_RegExpRange(re, 0, &dummy, &tail);
+ Tcl_RegExpRange(re, 2, &drive, &dummy);
+ Tcl_RegExpRange(re, 3, &hostStart, &hostEnd);
+ Tcl_RegExpRange(re, 4, &shareStart, &shareEnd);
+ Tcl_RegExpRange(re, 6, &lastSlash, &dummy);
+
+ if (drive != NULL) {
+ Tcl_DStringAppend(resultPtr, drive, 2);
+ if (lastSlash != NULL) {
Tcl_DStringAppend(resultPtr, "/", 1);
}
- } else if (winRootPatternPtr->startp[4] != NULL) {
+ } else if (shareStart != NULL) {
Tcl_DStringAppend(resultPtr, "//", 2);
- length = winRootPatternPtr->endp[3]
- - winRootPatternPtr->startp[3];
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[3], length);
+ length = hostEnd - hostStart;
+ Tcl_DStringAppend(resultPtr, hostStart, length);
Tcl_DStringAppend(resultPtr, "/", 1);
- length = winRootPatternPtr->endp[4]
- - winRootPatternPtr->startp[4];
- Tcl_DStringAppend(resultPtr, winRootPatternPtr->startp[4], length);
+ length = shareEnd - shareStart;
+ Tcl_DStringAppend(resultPtr, shareStart, length);
} else {
Tcl_DStringAppend(resultPtr, "/", 1);
}
- return winRootPatternPtr->endp[0];
+ return tail;
}
/*
@@ -197,7 +224,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,45 +243,51 @@ 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] != '~') {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* 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]))) {
+ FileNameInit();
+ re = Tcl_GetRegExpFromObj(NULL, tsdPtr->winRootPatternPtr,
+ REG_ADVANCED);
+
+ if (Tcl_RegExpExec(NULL, re, path, path)) {
+ char *drive, *dummy, *unixRoot, *lastSlash;
+
+ Tcl_RegExpRange(re, 2, &drive, &dummy);
+ Tcl_RegExpRange(re, 5, &unixRoot, &dummy);
+ Tcl_RegExpRange(re, 6, &lastSlash, &dummy);
+
+ if (unixRoot || (drive && !lastSlash)) {
type = TCL_PATH_VOLUME_RELATIVE;
}
} else {
@@ -292,7 +327,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 +336,7 @@ Tcl_SplitPath(path, argcPtr, argvPtr)
int i, size;
char *p;
Tcl_DString buffer;
+
Tcl_DStringInit(&buffer);
/*
@@ -385,11 +421,11 @@ 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.
@@ -447,11 +483,11 @@ 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;
p = ExtractWinRoot(path, bufPtr, 0);
@@ -505,88 +541,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 +736,8 @@ Tcl_JoinPath(argc, argv, resultPtr)
{
int oldLength, length, i, needsSep;
Tcl_DString buffer;
- char *p, c, *dest;
+ char c, *dest;
+ CONST char *p;
Tcl_DStringInit(&buffer);
oldLength = Tcl_DStringLength(resultPtr);
@@ -884,25 +931,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 +960,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;
@@ -933,8 +981,8 @@ Tcl_TranslateFileName(interp, name, bufferPtr)
Tcl_SplitPath(name, &argc, &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) {
@@ -1051,9 +1099,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.
@@ -1065,16 +1114,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);
@@ -1084,13 +1134,16 @@ DoTildeSubst(interp, user, resultPtr)
return NULL;
}
Tcl_JoinPath(1, &dir, resultPtr);
- } else if (TclGetUserHome(user, resultPtr) == NULL) {
- if (interp) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
- (char *) NULL);
+ Tcl_DStringFree(&dirString);
+ } else {
+ if (TclpGetUserHome(user, resultPtr) == NULL) {
+ if (interp) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
+ (char *) NULL);
+ }
+ return NULL;
}
- return NULL;
}
return resultPtr->string;
}
@@ -1098,7 +1151,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.
@@ -1114,42 +1167,104 @@ 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;
+ int index, i, noComplain, skip, length;
+ char *string;
+ static char *options[] = {"-nocomplain", "--", NULL};
+ enum options {GLOB_NOCOMPLAIN, GLOB_LAST};
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++;
+ for (skip = 1; skip < objc; skip++) {
+ string = Tcl_GetString(objv[skip]);
+ if (string[0] != '-') {
break;
- } else {
- Tcl_AppendResult(interp, "bad switch \"", argv[firstArg],
- "\": must be -nocomplain or --", (char *) NULL);
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
+ TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
+ if (index == GLOB_NOCOMPLAIN) {
+ noComplain = 1;
+ } else {
+ skip++;
+ break;
+ }
}
- if (firstArg >= argc) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " ?switches? name ?name ...?\"", (char *) NULL);
+ if (skip >= objc) {
+ 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) {
+ for (i = skip; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ if (TclGlob(interp, string, noComplain) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (noComplain == 0) {
+ Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+ if (length == 0) {
+ char *sep = "";
+
+ Tcl_AppendResult(interp, "no files matched glob pattern",
+ (objc == 2) ? " \"" : "s \"", (char *) NULL);
+ for (i = skip; i < objc; i++) {
+ string = Tcl_GetString(objv[i]);
+ Tcl_AppendResult(interp, sep, string, (char *) NULL);
+ sep = " ";
+ }
+ Tcl_AppendResult(interp, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclGlob(interp, pattern, noComplain)
+ 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. */
+ int noComplain; /* Flag to turn off storing error messages
+ * in interp. */
+{
+ char *separators;
+ char *head, *tail;
+ char c;
+ int result;
+ Tcl_DString buffer;
+
+ separators = NULL; /* lint. */
+ switch (tclPlatform) {
case TCL_PLATFORM_UNIX:
separators = "/";
break;
@@ -1157,102 +1272,84 @@ Tcl_GlobCmd(dummy, interp, argc, argv)
separators = "/\\:";
break;
case TCL_PLATFORM_MAC:
- separators = (strchr(argv[i], ':') == NULL) ? "/" : ":";
+ separators = (strchr(pattern, ':') == NULL)
+ ? "/" : ":";
break;
- }
+ }
- Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringInit(&buffer);
- /*
- * Perform tilde substitution, if needed.
- */
+ /*
+ * Perform tilde substitution, if needed.
+ */
- if (argv[i][0] == '~') {
- char *p;
+ if (pattern[0] == '~') {
+ char *p;
- /*
- * Find the first path separator after the tilde.
- */
+ /*
+ * 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) {
+ for (tail = pattern; *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';
- 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);
- }
- head = NULL;
- }
- *tail = c;
- if (head == NULL) {
- if (noComplain) {
- Tcl_ResetResult(interp);
- continue;
- } else {
- result = TCL_ERROR;
- goto done;
- }
- }
- if (head != Tcl_DStringValue(&buffer)) {
- Tcl_DStringAppend(&buffer, head, -1);
- }
+ /*
+ * 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(pattern+1, "\\[]*?{}");
+ if (p == NULL) {
+ head = DoTildeSubst(interp, pattern+1, &buffer);
} else {
- tail = argv[i];
+ if (!noComplain) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "globbing characters not ",
+ "supported in user names", (char *) NULL);
+ }
+ head = NULL;
}
-
- result = TclDoGlob(interp, separators, &buffer, tail);
- if (result != TCL_OK) {
+ *tail = c;
+ if (head == NULL) {
if (noComplain) {
/*
* 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);
+ }
+ } else {
+ tail = pattern;
}
- 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 = " ";
+ result = TclDoGlob(interp, separators, &buffer, tail);
+ Tcl_DStringFree(&buffer);
+ if (result != TCL_OK) {
+ if (noComplain) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
}
- Tcl_AppendResult(interp, "\"", (char *) NULL);
- result = TCL_ERROR;
}
-done:
- Tcl_DStringFree(&buffer);
return result;
}
@@ -1339,11 +1436,12 @@ TclDoGlob(interp, separators, headPtr, tail)
* 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. */
{
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);
@@ -1515,6 +1613,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, "*[]?\\");
@@ -1528,11 +1632,11 @@ 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 TclpMatchFiles(interp, separators, headPtr, tail, p);
}
Tcl_DStringAppend(headPtr, tail, p-tail);
if (*p != '\0') {
@@ -1546,21 +1650,23 @@ 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_AppendElement(interp, name + 1);
} else {
Tcl_AppendElement(interp, name);
}
}
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
@@ -1582,7 +1688,8 @@ 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 = '/';
@@ -1593,7 +1700,7 @@ TclDoGlob(interp, separators, headPtr, tail)
}
break;
}
- case TCL_PLATFORM_UNIX:
+ case TCL_PLATFORM_UNIX: {
if (Tcl_DStringLength(headPtr) == 0) {
if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
Tcl_DStringAppend(headPtr, "/", 1);
@@ -1602,10 +1709,11 @@ TclDoGlob(interp, separators, headPtr, tail)
}
}
name = Tcl_DStringValue(headPtr);
- if (TclAccess(name, F_OK) == 0) {
+ if (TclpAccess(name, F_OK) == 0) {
Tcl_AppendElement(interp, name);
}
break;
+ }
}
return TCL_OK;
diff --git a/generic/tclGet.c b/generic/tclGet.c
index e236741..27e49cc 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -6,12 +6,12 @@
* 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.
*
- * RCS: @(#) $Id: tclGet.c,v 1.2 1998/09/14 18:39:59 stanton Exp $
+ * RCS: @(#) $Id: tclGet.c,v 1.3 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -29,7 +29,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,17 +54,17 @@ 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:
@@ -86,11 +86,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 +113,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 +124,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,17 +140,17 @@ 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:
@@ -163,11 +165,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 +191,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 +210,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) {
@@ -220,22 +222,11 @@ Tcl_GetDouble(interp, string, doublePtr)
}
if (errno != 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 +248,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 +270,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++) {
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index 66e43e1..2f519dce 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclGetDate.y,v 1.3 1999/03/10 05:52:48 stanton Exp $
+ * RCS: @(#) $Id: tclGetDate.y,v 1.4 1999/04/16 00:46:46 stanton Exp $
*/
%{
@@ -692,11 +692,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 +766,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;
@@ -815,10 +813,10 @@ yylex()
yyInput++;
}
- if (isdigit(c = *yyInput) || c == '-' || c == '+') {
+ if (isdigit(c = *yyInput) || c == '-' || c == '+') { /* INTL: digit */
if (c == '-' || c == '+') {
sign = c == '-' ? -1 : 1;
- if (!isdigit(*++yyInput)) {
+ if (!isdigit(*++yyInput)) { /* INTL: digit */
/*
* skip the '-' sign
*/
@@ -827,7 +825,8 @@ yylex()
} else {
sign = 0;
}
- for (yylval.Number = 0; isdigit(c = *yyInput++); ) {
+ for (yylval.Number = 0;
+ isdigit(c = *yyInput++); ) { /* INTL: digit */
yylval.Number = 10 * yylval.Number + c - '0';
}
yyInput--;
@@ -836,8 +835,9 @@ yylex()
}
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(c = *yyInput++) /* INTL: ISO only. */
+ || c == '.'; ) {
if (p < &buff[sizeof buff - 1]) {
*p++ = c;
}
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 85596c3..973c003 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclHash.c,v 1.2 1998/09/14 18:39:59 stanton Exp $
+ * RCS: @(#) $Id: tclHash.c,v 1.3 1999/04/16 00:46:46 stanton Exp $
*/
#include "tclInt.h"
@@ -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/generic/tclHistory.c b/generic/tclHistory.c
index 495880f..5f2a9f2 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclHistory.c,v 1.2 1998/09/14 18:39:59 stanton Exp $
+ * RCS: @(#) $Id: tclHistory.c,v 1.3 1999/04/16 00:46:47 stanton Exp $
*/
#include "tclInt.h"
@@ -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/generic/tclIO.c b/generic/tclIO.c
index 9725902..32c844e 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,11 +10,11 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIO.c,v 1.5 1998/10/30 00:38:38 welch Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.6 1999/04/16 00:46:47 stanton Exp $
*/
-#include "tclInt.h"
-#include "tclPort.h"
+#include "tclInt.h"
+#include "tclPort.h"
/*
* Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
@@ -65,7 +65,7 @@ typedef struct ChannelBuffer {
* 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? */
+ int bufLength; /* How big is the buffer? */
struct ChannelBuffer *nextPtr;
/* Next buffer in chain. */
char buf[4]; /* Placeholder for real buffer. The real
@@ -77,6 +77,14 @@ typedef struct 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.
*/
@@ -105,7 +113,7 @@ typedef struct EventScriptRecord {
* registered. This is used only when an
* error occurs during evaluation of the
* script, to delete the handler. */
- char *script; /* Script to invoke. */
+ 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. */
@@ -128,6 +136,25 @@ typedef struct Channel {
* 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? */
@@ -142,12 +169,17 @@ typedef struct Channel {
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. */
+ ClientData instanceData; /* Instance-specific data provided by
+ * creator of channel. */
+
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. */
+ 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. */
@@ -210,6 +242,9 @@ typedef struct Channel {
#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
@@ -217,11 +252,15 @@ typedef struct Channel {
* 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.
+#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 unless
- * an EOL is present. */
+ * delivered for buffered data until
+ * the state of the channel changes. */
/*
* For each channel handler registered in a call to Tcl_CreateChannelHandler,
@@ -264,23 +303,6 @@ typedef struct NextChannelHandler {
* 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;
/*
* The following structure describes the event that is added to the Tcl
@@ -294,31 +316,106 @@ typedef struct ChannelHandlerEvent {
} ChannelHandlerEvent;
/*
- * Static variables to hold channels for stdin, stdout and stderr.
+ * 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;
+
+/*
+ * 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 {
+
+ /*
+ * This variable holds the list of nested ChannelHandlerEventProc
+ * invocations.
+ */
+ NextChannelHandler *nestedHandlerPtr;
+
+ /*
+ * List of all channels currently open.
+ */
+ Channel *firstChanPtr;
+#ifdef oldcode
+ /*
+ * Has a channel exit handler been created yet?
+ */
+ int channelExitHandlerCreated;
+
+ /*
+ * 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;
+
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
-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 functions in this file:
*/
+static ChannelBuffer * AllocChannelBuffer _ANSI_ARGS_((int length));
static void ChannelEventScriptInvoker _ANSI_ARGS_((
ClientData clientData, int flags));
static void ChannelTimerProc _ANSI_ARGS_((
ClientData clientData));
+static int CheckChannelErrors _ANSI_ARGS_((Channel *chanPtr,
+ int direction));
+static int CheckFlush _ANSI_ARGS_((Channel *chanPtr,
+ ChannelBuffer *bufPtr, int newlineFlag));
+static int CheckForDeadChannel _ANSI_ARGS_((Tcl_Interp *interp,
+ Channel *chan));
static void CheckForStdChannelsBeingClosed _ANSI_ARGS_((
Tcl_Channel chan));
static void CleanupChannelHandlers _ANSI_ARGS_((
Tcl_Interp *interp, Channel *chanPtr));
static int CloseChannel _ANSI_ARGS_((Tcl_Interp *interp,
Channel *chanPtr, int errorCode));
-static void CloseChannelsOnExit _ANSI_ARGS_((ClientData data));
+static void CommonGetsCleanup _ANSI_ARGS_((Channel *chanPtr,
+ Tcl_Encoding encoding));
static int CopyAndTranslateBuffer _ANSI_ARGS_((
Channel *chanPtr, char *result, int space));
static int CopyData _ANSI_ARGS_((CopyState *csPtr, int mask));
@@ -326,7 +423,7 @@ static void CopyEventProc _ANSI_ARGS_((ClientData clientData,
int mask));
static void CreateScriptRecord _ANSI_ARGS_((
Tcl_Interp *interp, Channel *chanPtr,
- int mask, char *script));
+ int mask, Tcl_Obj *scriptPtr));
static void DeleteChannelTable _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp));
static void DeleteScriptRecord _ANSI_ARGS_((Tcl_Interp *interp,
@@ -337,73 +434,162 @@ static void DiscardOutputQueued _ANSI_ARGS_((
Channel *chanPtr));
static int DoRead _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
int slen));
-static int DoWrite _ANSI_ARGS_((Channel *chanPtr, char *srcPtr,
- 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));
+static Tcl_HashTable * GetChannelTable _ANSI_ARGS_((Tcl_Interp *interp));
static int GetInput _ANSI_ARGS_((Channel *chanPtr));
+static void PeekAhead _ANSI_ARGS_((Channel *chanPtr,
+ char **dstEndPtr, GetsState *gsPtr));
+static int ReadBytes _ANSI_ARGS_((Channel *chanPtr,
+ Tcl_Obj *objPtr, int charsLeft, int *offsetPtr));
+static int ReadChars _ANSI_ARGS_((Channel *chanPtr,
+ Tcl_Obj *objPtr, int charsLeft, int *offsetPtr,
+ int *factorPtr));
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 int SetBlockMode _ANSI_ARGS_((Tcl_Interp *interp,
Channel *chanPtr, int mode));
static void StopCopy _ANSI_ARGS_((CopyState *csPtr));
+static int TranslateInputEOL _ANSI_ARGS_((Channel *chanPtr,
+ char *dst, CONST char *src, int *dstLenPtr,
+ int *srcLenPtr));
+static int TranslateOutputEOL _ANSI_ARGS_((Channel *chanPtr,
+ 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. */
+ Channel *nextChanPtr; /* Iterates over open channels. */
+
+
+ for (chanPtr = tsdPtr->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 *) 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.
+ */
+
+ 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.
+ */
+
+ 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;
+ chanPtr->flags |= CHANNEL_DEAD;
+ }
}
- return TCL_OK;
}
+
+
/*
*----------------------------------------------------------------------
@@ -427,18 +613,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 +646,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 +673,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;
}
+
/*
*----------------------------------------------------------------------
@@ -632,109 +797,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
@@ -859,7 +921,7 @@ DeleteChannelTable(clientData, interp)
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
ChannelEventScriptInvoker, (ClientData) sPtr);
- ckfree(sPtr->script);
+ Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
} else {
prevPtr = sPtr;
@@ -912,23 +974,24 @@ CheckForStdChannelsBeingClosed(chan)
Tcl_Channel chan;
{
Channel *chanPtr = (Channel *) chan;
-
- if ((chan == stdinChannel) && (stdinInitialized)) {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if ((chan == tsdPtr->stdinChannel) && (tsdPtr->stdinInitialized)) {
if (chanPtr->refCount < 2) {
chanPtr->refCount = 0;
- stdinChannel = NULL;
+ tsdPtr->stdinChannel = NULL;
return;
}
- } else if ((chan == stdoutChannel) && (stdoutInitialized)) {
+ } else if ((chan == tsdPtr->stdoutChannel) && (tsdPtr->stdoutInitialized)) {
if (chanPtr->refCount < 2) {
chanPtr->refCount = 0;
- stdoutChannel = NULL;
+ tsdPtr->stdoutChannel = NULL;
return;
}
- } else if ((chan == stderrChannel) && (stderrInitialized)) {
+ } else if ((chan == tsdPtr->stderrChannel) && (tsdPtr->stderrInitialized)) {
if (chanPtr->refCount < 2) {
chanPtr->refCount = 0;
- stderrChannel = NULL;
+ tsdPtr->stderrChannel = NULL;
return;
}
}
@@ -937,6 +1000,54 @@ 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. */
+
+ 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_UnregisterChannel --
*
* Deletes the hash entry for a channel associated with an interpreter.
@@ -1027,55 +1138,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 +1147,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
@@ -1175,6 +1238,8 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
* if the channel is readable, writable. */
{
Channel *chanPtr; /* The channel structure newly created. */
+ CONST char *name;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
chanPtr = (Channel *) ckalloc((unsigned) sizeof(Channel));
@@ -1188,6 +1253,20 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
chanPtr->flags = mask;
/*
+ * Set the channel to system default encoding.
+ */
+
+ chanPtr->encoding = NULL;
+ name = Tcl_GetEncodingName(NULL);
+ if (strcmp(name, "binary") != 0) {
+ chanPtr->encoding = Tcl_GetEncoding(NULL, name);
+ }
+ chanPtr->inputEncodingState = NULL;
+ chanPtr->inputEncodingFlags = TCL_ENCODING_START;
+ chanPtr->outputEncodingState = NULL;
+ chanPtr->outputEncodingFlags = TCL_ENCODING_START;
+
+ /*
* Set the channel up initially in AUTO input translation mode to
* accept "\n", "\r" and "\r\n". Output translation mode is set to
* a platform specific default value. The eofChar is set to 0 for both
@@ -1218,32 +1297,33 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
chanPtr->timer = NULL;
chanPtr->csPtr = NULL;
+ chanPtr->outputStage = NULL;
+ if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
+ chanPtr->outputStage = (char *)
+ ckalloc((unsigned) (chanPtr->bufSize + 2));
+ }
+
/*
* Link the channel into the list of all channels; create an on-exit
* handler if there is not one already, to close off all the channels
* in the list on exit.
*/
- chanPtr->nextChanPtr = firstChanPtr;
- firstChanPtr = chanPtr;
+ chanPtr->nextChanPtr = tsdPtr->firstChanPtr;
+ tsdPtr->firstChanPtr = chanPtr;
- 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)) {
+ 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)) {
+ } 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)) {
+ } else if ((tsdPtr->stderrChannel == NULL) && (tsdPtr->stderrInitialized == 1)) {
Tcl_SetStdChannel((Tcl_Channel)chanPtr, TCL_STDERR);
Tcl_RegisterChannel((Tcl_Interp *) NULL, (Tcl_Channel) chanPtr);
}
@@ -1395,6 +1475,47 @@ Tcl_GetChannelInstanceData(chan)
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * AllocChannelBuffer --
+ *
+ * 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:
+ * A newly allocated channel buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static ChannelBuffer *
+AllocChannelBuffer(length)
+ int length; /* Desired length of channel buffer. */
+{
+ 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;
+}
+
+/*
*----------------------------------------------------------------------
*
* RecycleBuffer --
@@ -1465,8 +1586,8 @@ RecycleBuffer(chanPtr, bufPtr, mustDiscard)
return;
keepit:
- bufPtr->nextRemoved = 0;
- bufPtr->nextAdded = 0;
+ bufPtr->nextRemoved = BUFFER_PADDING;
+ bufPtr->nextAdded = BUFFER_PADDING;
bufPtr->nextPtr = (ChannelBuffer *) NULL;
}
@@ -1570,9 +1691,10 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
* 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
@@ -1597,7 +1719,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
*/
if (((chanPtr->curOutPtr != (ChannelBuffer *) NULL) &&
- (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufSize))
+ (chanPtr->curOutPtr->nextAdded == chanPtr->curOutPtr->bufLength))
|| ((chanPtr->flags & BUFFER_READY) &&
(chanPtr->outQueueHead == (ChannelBuffer *) NULL))) {
chanPtr->flags &= (~(BUFFER_READY));
@@ -1636,7 +1758,8 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
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
@@ -1696,7 +1819,9 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
DiscardOutputQueued(chanPtr);
continue;
- }
+ } else {
+ wroteSome = 1;
+ }
bufPtr->nextRemoved += written;
@@ -1712,17 +1837,22 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
RecycleBuffer(chanPtr, 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 (chanPtr->flags & BG_FLUSH_SCHEDULED) {
+ if (wroteSome) {
+ return errorCode;
+ } else if (chanPtr->outQueueHead == (ChannelBuffer *) NULL) {
+ chanPtr->flags &= (~(BG_FLUSH_SCHEDULED));
+ (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
+ chanPtr->interestMask);
+ }
}
/*
@@ -1769,7 +1899,8 @@ CloseChannel(interp, chanPtr, errorCode)
Channel *prevChanPtr; /* Preceding channel in list of
* all channels - used to splice a
* channel out of the list on close. */
-
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
if (chanPtr == NULL) {
return result;
}
@@ -1825,10 +1956,10 @@ CloseChannel(interp, chanPtr, errorCode)
* Splice this channel out of the list of all channels.
*/
- if (chanPtr == firstChanPtr) {
- firstChanPtr = chanPtr->nextChanPtr;
+ if (chanPtr == tsdPtr->firstChanPtr) {
+ tsdPtr->firstChanPtr = chanPtr->nextChanPtr;
} else {
- for (prevChanPtr = firstChanPtr;
+ for (prevChanPtr = tsdPtr->firstChanPtr;
(prevChanPtr != (Channel *) NULL) &&
(prevChanPtr->nextChanPtr != chanPtr);
prevChanPtr = prevChanPtr->nextChanPtr) {
@@ -1841,14 +1972,23 @@ CloseChannel(interp, chanPtr, errorCode)
}
/*
- * OK, close the channel itself.
+ * Close and free the channel driver state.
*/
-
- result = (chanPtr->typePtr->closeProc) (chanPtr->instanceData, interp);
+
+ if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
+ result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
+ } else {
+ result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
+ 0);
+ }
if (chanPtr->channelName != (char *) NULL) {
ckfree(chanPtr->channelName);
}
+ Tcl_FreeEncoding(chanPtr->encoding);
+ if (chanPtr->outputStage != NULL) {
+ ckfree((char *) chanPtr->outputStage);
+ }
/*
* If we are being called synchronously, report either
@@ -1918,6 +2058,7 @@ Tcl_Close(interp, chan)
EventScriptRecord *ePtr, *eNextPtr; /* Iterate over eventscript records. */
Channel *chanPtr; /* The real IO channel. */
int result; /* Of calling FlushChannel. */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler *nhPtr;
if (chan == (Tcl_Channel) NULL) {
@@ -1944,7 +2085,7 @@ Tcl_Close(interp, chan)
* may be about to be invoked.
*/
- for (nhPtr = nestedHandlerPtr;
+ for (nhPtr = tsdPtr->nestedHandlerPtr;
nhPtr != (NextChannelHandler *) NULL;
nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr &&
@@ -1990,7 +2131,7 @@ Tcl_Close(interp, chan)
ePtr != (EventScriptRecord *) NULL;
ePtr = eNextPtr) {
eNextPtr = ePtr->nextPtr;
- ckfree(ePtr->script);
+ Tcl_DecrRefCount(ePtr->scriptPtr);
ckfree((char *) ePtr);
}
chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
@@ -2016,17 +2157,27 @@ Tcl_Close(interp, chan)
}
/*
+ * 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;
+ }
+
+ /*
* The call to FlushChannel will flush any queued output and invoke
* the close function of the channel driver, or it will set up the
* channel to be flushed and closed asynchronously.
*/
-
+
chanPtr->flags |= CHANNEL_CLOSED;
- result = FlushChannel(interp, chanPtr, 0);
- if (result != 0) {
+ if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
return TCL_ERROR;
}
-
return TCL_OK;
}
@@ -2035,7 +2186,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,63 +2203,33 @@ 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.
- */
-
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
- }
-
- /*
- * If the channel is not open for writing punt.
- */
-
- if (!(chanPtr->flags & TCL_WRITABLE)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
- /*
- * If the channel is in the middle of a background copy, fail.
- */
+ Channel *chanPtr;
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
+ chanPtr = (Channel *) chan;
+ if (CheckChannelErrors(chanPtr, 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_WriteChars --
*
- * 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
+ * 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:
@@ -2122,906 +2243,854 @@ 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. */
-{
- 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? */
-
- /*
- * 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 (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.
- */
-
- 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" */
-
- return totalDestCopied;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
+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. */
+ Channel *chanPtr;
chanPtr = (Channel *) chan;
-
- /*
- * Check for unreported error.
- */
-
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return TCL_ERROR;
+ if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ return -1;
}
-
- /*
- * If the channel is not open for writing punt.
- */
-
- if (!(chanPtr->flags & TCL_WRITABLE)) {
- Tcl_SetErrno(EACCES);
- return TCL_ERROR;
+ if (len < 0) {
+ len = strlen(src);
}
-
- /*
- * If the channel is in the middle of a background copy, fail.
- */
+ if (chanPtr->encoding == NULL) {
+ /*
+ * Inefficient way to convert UTF-8 to byte-array, but the
+ * code parallels the way it is done for objects.
+ */
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
- return -1;
- }
+ Tcl_Obj *objPtr;
+ int result;
- /*
- * 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;
+ objPtr = Tcl_NewStringObj(src, len);
+ src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
+ result = WriteBytes(chanPtr, src, len);
+ Tcl_DecrRefCount(objPtr);
+ return result;
}
-
- return TCL_OK;
+ 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. */
+ Channel *chanPtr;
+ char *src;
+ int srcLen;
- bufPtr = chanPtr->inQueueHead;
- chanPtr->inQueueHead = (ChannelBuffer *) NULL;
- chanPtr->inQueueTail = (ChannelBuffer *) NULL;
- for (; bufPtr != (ChannelBuffer *) NULL; bufPtr = nxtPtr) {
- nxtPtr = bufPtr->nextPtr;
- RecycleBuffer(chanPtr, bufPtr, discardSavedBuffers);
+ chanPtr = (Channel *) chan;
+ if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ return -1;
}
-
- /*
- * If discardSavedBuffers is nonzero, must also discard any previously
- * saved buffer in the saveInBufPtr field.
- */
-
- if (discardSavedBuffers) {
- if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
- ckfree((char *) chanPtr->saveInBufPtr);
- chanPtr->saveInBufPtr = (ChannelBuffer *) NULL;
- }
+ if (chanPtr->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.
- */
+ 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 = chanPtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(chanPtr->bufSize);
+ chanPtr->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(chanPtr, 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. */
+ 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 = chanPtr->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;
+ while (srcLen + savedLF > 0) {
+ stage = chanPtr->outputStage;
+ stageMax = chanPtr->bufSize;
+ stageLen = stageMax;
- case TCL_TRANSLATE_CR:
-
- 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:
+ * 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(chanPtr, stage, src, &stageLen, &toWrite);
- /*
- * 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;
- }
+ stage -= savedLF;
+ stageLen += savedLF;
+ savedLF = 0;
- /*
- * Copy the current chunk and replace "\r\n" with "\n"
- * (but not standalone "\r"!).
- */
-
- 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 = chanPtr->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 = chanPtr->curOutPtr;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(chanPtr->bufSize);
+ chanPtr->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,
+ &chanPtr->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(chanPtr, dst, src, dstLenPtr, srcLenPtr)
+ Channel *chanPtr; /* 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 (chanPtr->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;
+ /*
+ * 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 ((chanPtr->flags & BUFFER_READY) == 0) {
+ if (bufPtr->nextAdded == bufPtr->bufLength) {
+ chanPtr->flags |= BUFFER_READY;
+ } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+ if (newlineFlag != 0) {
+ chanPtr->flags |= BUFFER_READY;
+ }
+ } else if (chanPtr->flags & CHANNEL_UNBUFFERED) {
+ chanPtr->flags |= BUFFER_READY;
+ }
}
- return bytesToEOL;
+ if (chanPtr->flags & BUFFER_READY) {
+ if (FlushChannel(NULL, chanPtr, 0) != 0) {
+ return -1;
+ }
+ }
+ 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:
- * Consumes input from the channel.
+ * May flush output on the channel. May cause input to be consumed
+ * from the channel.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-static int
-GetEOL(chanPtr)
- Channel *chanPtr; /* Channel to queue input on. */
+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. */
{
- 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? */
+ 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.
+ *
+ *---------------------------------------------------------------------------
+ */
- /*
- * Check for unreported error.
- */
+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. */
+{
+ GetsState gs;
+ Channel *chanPtr;
+ int inEofChar, skip, copiedTotal;
+ ChannelBuffer *bufPtr;
+ Tcl_Encoding encoding;
+ char *dst, *dstEnd, *eol, *eof;
+ Tcl_EncodingState oldState;
+ int oldLength, oldFlags, oldRemoved;
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
+ chanPtr = (Channel *) chan;
+ if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ copiedTotal = -1;
+ goto done;
}
+ bufPtr = chanPtr->inQueueHead;
+ encoding = chanPtr->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 = chanPtr->inputEncodingFlags;
+ oldState = chanPtr->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 = chanPtr->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 (chanPtr->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 (chanPtr->flags & INPUT_SAW_CR) {
+ chanPtr->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, chanPtr->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--;
+ chanPtr->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;
+ chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ }
+ if (chanPtr->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;
}
- blocked:
+ /*
+ * 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;
+ chanPtr->inputEncodingState = gs.state;
+ Tcl_ExternalToUtf(NULL, gs.encoding, bufPtr->buf + bufPtr->nextRemoved,
+ gs.rawRead, chanPtr->inputEncodingFlags,
+ &chanPtr->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);
+ chanPtr->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 = chanPtr->inQueueHead;
+ bufPtr->nextRemoved = oldRemoved;
+
+ for (bufPtr = bufPtr->nextPtr; bufPtr != NULL; bufPtr = bufPtr->nextPtr) {
+ bufPtr->nextRemoved = BUFFER_PADDING;
+ }
+ CommonGetsCleanup(chanPtr, encoding);
+
+ chanPtr->inputEncodingState = oldState;
+ chanPtr->inputEncodingFlags = oldFlags;
+ Tcl_SetObjLength(objPtr, oldLength);
/*
* We didn't get a complete line so we need to indicate to UpdateInterest
@@ -3034,77 +3103,349 @@ GetEOL(chanPtr)
* though a read would be able to consume the buffered data.
*/
- chanPtr->flags |= CHANNEL_GETS_BLOCKED;
- return -1;
+ chanPtr->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 --
*
- * Reads a given number of characters from a channel.
+ * Helper function for Tcl_GetsObj. Produces UTF-8 characters from
+ * raw bytes read from the 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;
+ 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 (chanPtr->flags & CHANNEL_BLOCKED) {
+ if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
+ chanPtr->flags &= ~CHANNEL_BLOCKED;
+ }
+ if (GetInput(chanPtr) != 0) {
+ gsPtr->charsWrote = 0;
+ gsPtr->rawRead = 0;
+ return -1;
+ }
+ bufPtr = chanPtr->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 = chanPtr->inputEncodingState;
+ result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
+ chanPtr->inputEncodingFlags, &chanPtr->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 (chanPtr->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(chanPtr->bufSize);
+ bufPtr->nextPtr = nextPtr;
+ chanPtr->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. */
+{
+ ChannelBuffer *bufPtr;
+ Tcl_DriverBlockModeProc *blockModeProc;
+ int bytesLeft;
+
+ bufPtr = gsPtr->bufPtr;
+
/*
- * If the channel is in the middle of a background copy, fail.
+ * 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.
*/
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
- return -1;
+ 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 ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) {
+ blockModeProc = chanPtr->typePtr->blockModeProc;
+ if (blockModeProc == NULL) {
+ /*
+ * Don't peek ahead if cannot set non-blocking mode.
+ */
+
+ goto cleanup;
+ }
+ (*blockModeProc)(chanPtr->instanceData, TCL_MODE_NONBLOCKING);
+ }
+ }
+ }
+ if (FilterInputBytes(chanPtr, gsPtr) == 0) {
+ *dstEndPtr = *gsPtr->dstPtr + gsPtr->bytesWrote;
+ }
+ if (blockModeProc != NULL) {
+ (*blockModeProc)(chanPtr->instanceData, TCL_MODE_BLOCKING);
}
+ return;
- return DoRead(chanPtr, bufPtr, toRead);
+ 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;
+{
+ ChannelBuffer *bufPtr, *nextPtr;
+
+ bufPtr = chanPtr->inQueueHead;
+ for ( ; bufPtr != NULL; bufPtr = nextPtr) {
+ nextPtr = bufPtr->nextPtr;
+ if (bufPtr->nextRemoved < bufPtr->nextAdded) {
+ break;
+ }
+ RecycleBuffer(chanPtr, bufPtr, 0);
+ }
+ chanPtr->inQueueHead = bufPtr;
+ if (bufPtr == NULL) {
+ chanPtr->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 (chanPtr->encoding == NULL) {
+ Tcl_FreeEncoding(encoding);
+ }
}
/*
*----------------------------------------------------------------------
*
- * DoRead --
+ * 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.
*
- * Reads a given number of characters from a channel.
+ * 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,53 +3454,142 @@ 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_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. */
{
- 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;
- /*
- * 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 (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
- chanPtr->flags &= (~(CHANNEL_EOF));
+ chanPtr = (Channel *) chan;
+ if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ return -1;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED | CHANNEL_GETS_BLOCKED));
+
+ return DoRead(chanPtr, dst, bytesToRead);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_ReadChars --
+ *
+ * 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:
+ * 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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+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;
+ int offset, factor, copied, copiedNow, result;
+ ChannelBuffer *bufPtr;
+ Tcl_Encoding encoding;
+#define UTF_EXPANSION_FACTOR 1024
- for (copied = 0; copied < toRead; copied += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
- toRead - copied);
- if (copiedNow == 0) {
- if (chanPtr->flags & CHANNEL_EOF) {
- goto done;
- }
- if (chanPtr->flags & CHANNEL_BLOCKED) {
- if (chanPtr->flags & CHANNEL_NONBLOCKING) {
- goto done;
- }
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
- }
- result = GetInput(chanPtr);
- if (result != 0) {
- if (result != EAGAIN) {
- copied = -1;
- }
- goto done;
- }
- }
+ chanPtr = (Channel *) chan;
+ if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ copied = -1;
+ goto done;
}
- chanPtr->flags &= (~(CHANNEL_BLOCKED));
+ encoding = chanPtr->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);
+ }
+ }
+
+ for (copied = 0; (unsigned) toRead > 0; ) {
+ copiedNow = -1;
+ if (chanPtr->inQueueHead != NULL) {
+ if (encoding == NULL) {
+ copiedNow = ReadBytes(chanPtr, objPtr, toRead, &offset);
+ } else {
+ copiedNow = ReadChars(chanPtr, objPtr, toRead, &offset,
+ &factor);
+ }
+
+ /*
+ * If the current buffer is empty recycle it.
+ */
+
+ bufPtr = chanPtr->inQueueHead;
+ if (bufPtr->nextRemoved == bufPtr->nextAdded) {
+ ChannelBuffer *nextPtr;
+
+ nextPtr = bufPtr->nextPtr;
+ RecycleBuffer(chanPtr, bufPtr, 0);
+ chanPtr->inQueueHead = nextPtr;
+ if (nextPtr == NULL) {
+ chanPtr->inQueueTail = nextPtr;
+ }
+ }
+ }
+ if (copiedNow < 0) {
+ if (chanPtr->flags & CHANNEL_EOF) {
+ break;
+ }
+ if (chanPtr->flags & CHANNEL_BLOCKED) {
+ if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ break;
+ }
+ chanPtr->flags &= ~CHANNEL_BLOCKED;
+ }
+ result = GetInput(chanPtr);
+ if (result != 0) {
+ if (result == EAGAIN) {
+ break;
+ }
+ copied = -1;
+ goto done;
+ }
+ } else {
+ copied += copiedNow;
+ toRead -= copiedNow;
+ }
+ }
+ chanPtr->flags &= ~CHANNEL_BLOCKED;
+ if (encoding == NULL) {
+ Tcl_SetByteArrayLength(objPtr, offset);
+ } else {
+ Tcl_SetObjLength(objPtr, offset);
+ }
done:
/*
@@ -3170,152 +3600,495 @@ DoRead(chanPtr, bufPtr, toRead)
UpdateInterest(chanPtr);
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(chanPtr, objPtr, bytesToRead, offsetPtr)
+ Channel *chanPtr; /* 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 = chanPtr->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 (chanPtr->flags & INPUT_NEED_NL) {
+ chanPtr->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(chanPtr, dst, src, &dstWrote, &srcRead) != 0) {
+ if (dstWrote == 0) {
+ return -1;
+ }
+ }
+ bufPtr->nextRemoved += srcRead;
+ *offsetPtr += dstWrote;
+ return dstWrote;
+}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_Gets --
+ * 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
- * Tcl_DString.
+ * '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_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. */
+static int
+ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr)
+ Channel *chanPtr; /* The 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 = chanPtr->inQueueHead;
+ src = bufPtr->buf + bufPtr->nextRemoved;
+ srcLen = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ toRead = charsToRead;
+ if ((unsigned) toRead > (unsigned) srcLen) {
+ toRead = srcLen;
}
- 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);
+ /*
+ * '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.
+ */
+
+ 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_DStringSetLength(lineRead, copiedTotal + offset);
+ dst = objPtr->bytes + offset;
+
+ oldState = chanPtr->inputEncodingState;
+ if (chanPtr->flags & INPUT_NEED_NL) {
+ /*
+ * We want a '\n' because the last character we saw was '\r'.
+ */
+
+ chanPtr->flags &= ~INPUT_NEED_NL;
+ Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
+ chanPtr->inputEncodingFlags, &chanPtr->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';
+ }
+ chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+ *offsetPtr += 1;
+ return 1;
+ }
+
+ Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
+ chanPtr->inputEncodingFlags, &chanPtr->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.
+ */
+
+ chanPtr->flags |= CHANNEL_NEED_MORE_DATA;
+ return -1;
+ }
+ nextPtr->nextRemoved -= srcLen;
+ memcpy((VOID *) (nextPtr->buf + nextPtr->nextRemoved), (VOID *) src,
+ (size_t) srcLen);
+ RecycleBuffer(chanPtr, bufPtr, 0);
+ chanPtr->inQueueHead = nextPtr;
+ return ReadChars(chanPtr, objPtr, charsToRead, offsetPtr, factorPtr);
+ }
+
+ dstRead = dstWrote;
+ if (TranslateInputEOL(chanPtr, 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;
+ }
+ chanPtr->inputEncodingState = oldState;
+ Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
+ chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
+ dst, dstRead + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
+ TranslateInputEOL(chanPtr, 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);
+ chanPtr->inputEncodingState = oldState;
+ Tcl_ExternalToUtf(NULL, chanPtr->encoding, src, srcLen,
+ chanPtr->inputEncodingFlags, &chanPtr->inputEncodingState,
+ dst, eof - dst + TCL_UTF_MAX, &srcRead, &dstWrote, &numChars);
+ dstRead = dstWrote;
+ TranslateInputEOL(chanPtr, dst, dst, &dstWrote, &dstRead);
+ numChars -= (dstRead - dstWrote);
+ }
+ chanPtr->inputEncodingFlags &= ~TCL_ENCODING_START;
+
+ bufPtr->nextRemoved += srcRead;
+ if (dstWrote > srcRead + 1) {
+ *factorPtr = dstWrote * UTF_EXPANSION_FACTOR / srcRead;
+ }
+ *offsetPtr += dstWrote;
+ return numChars;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_GetsObj --
+ * TranslateInputEOL --
*
- * Reads a complete line of input from the channel into a
- * string object.
+ * Perform input EOL and EOF translation on the source buffer,
+ * leaving the translated result in the destination buffer.
*
* 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 1 if the EOF character was found when copying
+ * bytes to the destination buffer, 0 otherwise.
*
* 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
+TranslateInputEOL(chanPtr, dstStart, srcStart, dstLenPtr, srcLenPtr)
+ Channel *chanPtr; /* 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. */
{
- 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 dstLen, srcLen, inEofChar;
+ CONST char *eof;
- lineLen = GetEOL(chanPtr);
- if (lineLen < 0) {
- copiedTotal = -1;
- goto done;
- }
+ dstLen = *dstLenPtr;
- (void) Tcl_GetStringFromObj(objPtr, &offset);
- Tcl_SetObjLength(objPtr, lineLen + offset);
- buf = Tcl_GetStringFromObj(objPtr, NULL) + offset;
+ eof = NULL;
+ inEofChar = chanPtr->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.
+ */
- for (copiedTotal = 0; copiedTotal < lineLen; copiedTotal += copiedNow) {
- copiedNow = CopyAndTranslateBuffer(chanPtr, buf + copiedTotal,
- lineLen - copiedTotal);
+ 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;
+ }
+ }
}
- if ((copiedTotal > 0) && (buf[copiedTotal - 1] == '\n')) {
- copiedTotal--;
+ switch (chanPtr->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) {
+ chanPtr->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 ((chanPtr->flags & INPUT_SAW_CR) && (src < srcMax)) {
+ if (*src == '\n') {
+ src++;
+ }
+ chanPtr->flags &= ~INPUT_SAW_CR;
+ }
+ for ( ; src < srcEnd; ) {
+ if (*src == '\r') {
+ src++;
+ if (src >= srcMax) {
+ chanPtr->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;
+ }
}
- Tcl_SetObjLength(objPtr, copiedTotal + offset);
+ *dstLenPtr = dstLen;
- done:
- /*
- * Update the notifier state so we don't block while there is still
- * data in the buffers.
- */
+ 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.
+ */
- UpdateInterest(chanPtr);
- return copiedTotal;
+ chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ chanPtr->flags &= ~(INPUT_SAW_CR | INPUT_NEED_NL);
+ return 1;
+ }
+
+ *srcLenPtr = srcLen;
+ return 0;
}
/*
@@ -3345,37 +4118,20 @@ Tcl_Ungets(chan, str, len, atEnd)
{
Channel *chanPtr; /* The real IO channel. */
ChannelBuffer *bufPtr; /* Buffer to contain the data. */
- int i;
+ int i, flags;
chanPtr = (Channel *) chan;
-
- /*
- * Check for unreported error.
- */
-
- if (chanPtr->unreportedError != 0) {
- Tcl_SetErrno(chanPtr->unreportedError);
- chanPtr->unreportedError = 0;
- return -1;
- }
-
- /*
- * Punt if the channel is not opened for reading.
- */
-
- if (!(chanPtr->flags & TCL_READABLE)) {
- Tcl_SetErrno(EACCES);
- return -1;
- }
-
+
/*
- * If the channel is in the middle of a background copy, fail.
+ * CheckChannelErrors clears too many flag bits in this one case.
*/
-
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
- return -1;
+
+ flags = chanPtr->flags;
+ if (CheckChannelErrors(chanPtr, TCL_READABLE) != 0) {
+ len = -1;
+ goto done;
}
+ chanPtr->flags = flags;
/*
* If we have encountered a sticky EOF, just punt without storing.
@@ -3386,18 +4142,15 @@ Tcl_Ungets(chan, str, len, atEnd)
*/
if (chanPtr->flags & CHANNEL_STICKY_EOF) {
- return len;
+ goto done;
}
chanPtr->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) {
bufPtr->nextPtr = (ChannelBuffer *) NULL;
@@ -3412,6 +4165,7 @@ Tcl_Ungets(chan, str, len, atEnd)
chanPtr->inQueueHead = bufPtr;
}
+ done:
/*
* Update the notifier state so we don't block while there is still
* data in the buffers.
@@ -3424,6 +4178,201 @@ 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; /* The actual channel. */
+
+ chanPtr = (Channel *) chan;
+ if (CheckChannelErrors(chanPtr, TCL_WRITABLE) != 0) {
+ return -1;
+ }
+
+ /*
+ * Force current output buffer to be output also.
+ */
+
+ if ((chanPtr->curOutPtr != NULL)
+ && (chanPtr->curOutPtr->nextAdded > 0)) {
+ chanPtr->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(chanPtr, discardSavedBuffers)
+ Channel *chanPtr; /* 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 = 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.
+ */
+
+ if (discardSavedBuffers) {
+ if (chanPtr->saveInBufPtr != (ChannelBuffer *) NULL) {
+ ckfree((char *) chanPtr->saveInBufPtr);
+ chanPtr->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. */
+
+ /*
+ * 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, chanPtr)) {
+ return EINVAL;
+ }
+
+ /*
+ * 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 = chanPtr->inQueueTail;
+ if ((bufPtr != NULL) && (bufPtr->nextAdded < bufPtr->bufLength)) {
+ toRead = bufPtr->bufLength - bufPtr->nextAdded;
+ } else {
+ bufPtr = chanPtr->saveInBufPtr;
+ chanPtr->saveInBufPtr = NULL;
+ if (bufPtr == NULL) {
+ bufPtr = AllocChannelBuffer(chanPtr->bufSize);
+ }
+ bufPtr->nextPtr = (ChannelBuffer *) NULL;
+
+ toRead = chanPtr->bufSize;
+ if (chanPtr->inQueueTail == NULL) {
+ chanPtr->inQueueHead = bufPtr;
+ } else {
+ chanPtr->inQueueTail->nextPtr = bufPtr;
+ }
+ chanPtr->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 (chanPtr->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) {
+ chanPtr->flags |= CHANNEL_BLOCKED;
+ }
+ } else if (nread == 0) {
+ chanPtr->flags |= CHANNEL_EOF;
+ chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ } else if (nread < 0) {
+ if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
+ chanPtr->flags |= CHANNEL_BLOCKED;
+ result = EAGAIN;
+ }
+ Tcl_SetErrno(result);
+ return result;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_Seek --
*
* Implements seeking on Tcl Channels. This is a public function
@@ -3455,33 +4404,7 @@ Tcl_Seek(chan, offset, mode)
* 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(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
return -1;
}
@@ -3657,15 +4580,8 @@ Tcl_Tell(chan)
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(chanPtr, TCL_WRITABLE | TCL_READABLE) != 0) {
+ return -1;
}
/*
@@ -3675,24 +4591,7 @@ 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 the channel is in the middle of a background copy, fail.
- */
-
- if (chanPtr->csPtr) {
- Tcl_SetErrno(EBUSY);
+ if (CheckForDeadChannel(NULL,chanPtr)) {
return -1;
}
@@ -3751,6 +4650,75 @@ 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(chanPtr, direction)
+ Channel *chanPtr; /* Channel to check. */
+ int direction; /* Test if channel supports desired operation:
+ * TCL_READABLE, TCL_WRITABLE. */
+{
+ /*
+ * Check for unreported error.
+ */
+
+ if (chanPtr->unreportedError != 0) {
+ Tcl_SetErrno(chanPtr->unreportedError);
+ chanPtr->unreportedError = 0;
+ return -1;
+ }
+
+ /*
+ * Fail if the channel is not opened for desired operation.
+ */
+
+ if ((chanPtr->flags & direction) == 0) {
+ Tcl_SetErrno(EACCES);
+ return -1;
+ }
+
+ /*
+ * Fail if the channel is in the middle of a background copy.
+ */
+
+ if (chanPtr->csPtr != NULL) {
+ 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 ((chanPtr->flags & CHANNEL_STICKY_EOF) == 0) {
+ chanPtr->flags &= ~CHANNEL_EOF;
+ }
+ chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+ }
+
+ return 0;
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_Eof --
@@ -3878,6 +4846,15 @@ Tcl_SetChannelBufferSize(chan, sz)
chanPtr = (Channel *) chan;
chanPtr->bufSize = sz;
+
+ if (chanPtr->outputStage != NULL) {
+ ckfree((char *) chanPtr->outputStage);
+ chanPtr->outputStage = NULL;
+ }
+ if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
+ chanPtr->outputStage = (char *)
+ ckalloc((unsigned) (chanPtr->bufSize + 2));
+ }
}
/*
@@ -4082,7 +5059,23 @@ Tcl_GetChannelOption(interp, chan, optionName, dsPtr)
}
}
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 (chanPtr->encoding == NULL) {
+ Tcl_DStringAppendElement(dsPtr, "binary");
+ } else {
+ Tcl_DStringAppendElement(dsPtr,
+ Tcl_GetEncodingName(chanPtr->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");
@@ -4180,20 +5173,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
@@ -4247,9 +5240,7 @@ 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)) {
@@ -4271,19 +5262,34 @@ 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);
+ chanPtr->bufSize = atoi(newValue); /* INTL: "C", UTF safe. */
if ((chanPtr->bufSize < 10) || (chanPtr->bufSize > (1024 * 1024))) {
chanPtr->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(chanPtr->encoding);
+ chanPtr->encoding = encoding;
+ chanPtr->inputEncodingState = NULL;
+ chanPtr->inputEncodingFlags = TCL_ENCODING_START;
+ chanPtr->outputEncodingState = NULL;
+ chanPtr->outputEncodingFlags = TCL_ENCODING_START;
+ chanPtr->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;
@@ -4317,10 +5323,8 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
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;
@@ -4350,8 +5354,10 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
} else if (strcmp(readMode, "auto") == 0) {
newMode = TCL_TRANSLATE_AUTO;
} else if (strcmp(readMode, "binary") == 0) {
- chanPtr->inEofChar = 0;
newMode = TCL_TRANSLATE_LF;
+ chanPtr->inEofChar = 0;
+ Tcl_FreeEncoding(chanPtr->encoding);
+ chanPtr->encoding = NULL;
} else if (strcmp(readMode, "lf") == 0) {
newMode = TCL_TRANSLATE_LF;
} else if (strcmp(readMode, "cr") == 0) {
@@ -4380,7 +5386,7 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
if (newMode != chanPtr->inputTranslation) {
chanPtr->inputTranslation = (Tcl_EolTranslation) newMode;
chanPtr->flags &= ~(INPUT_SAW_CR);
- chanPtr->flags &= ~(CHANNEL_GETS_BLOCKED);
+ chanPtr->flags &= ~(CHANNEL_NEED_MORE_DATA);
UpdateInterest(chanPtr);
}
}
@@ -4403,6 +5409,8 @@ Tcl_SetChannelOption(interp, chan, optionName, newValue)
} else if (strcmp(writeMode, "binary") == 0) {
chanPtr->outEofChar = 0;
chanPtr->outputTranslation = TCL_TRANSLATE_LF;
+ Tcl_FreeEncoding(chanPtr->encoding);
+ chanPtr->encoding = NULL;
} else if (strcmp(writeMode, "lf") == 0) {
chanPtr->outputTranslation = TCL_TRANSLATE_LF;
} else if (strcmp(writeMode, "cr") == 0) {
@@ -4424,14 +5432,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 (chanPtr->saveInBufPtr != NULL) {
+ RecycleBuffer(chanPtr, chanPtr->saveInBufPtr, 1);
+ chanPtr->saveInBufPtr = NULL;
+ }
+ if (chanPtr->inQueueHead != NULL) {
+ if ((chanPtr->inQueueHead->nextPtr == NULL)
+ && (chanPtr->inQueueHead->nextAdded ==
+ chanPtr->inQueueHead->nextRemoved)) {
+ RecycleBuffer(chanPtr, chanPtr->inQueueHead, 1);
+ chanPtr->inQueueHead = NULL;
+ chanPtr->inQueueTail = NULL;
+ }
}
-
- return Tcl_BadChannelOption(interp, optionName, (char *) NULL);
+
+ /*
+ * If encoding or bufsize changes, need to update output staging buffer.
+ */
+
+ if (chanPtr->outputStage != NULL) {
+ ckfree((char *) chanPtr->outputStage);
+ chanPtr->outputStage = NULL;
+ }
+ if ((chanPtr->encoding != NULL) && (chanPtr->flags & TCL_WRITABLE)) {
+ chanPtr->outputStage = (char *)
+ ckalloc((unsigned) (chanPtr->bufSize + 2));
+ }
+ return TCL_OK;
}
/*
@@ -4481,7 +5519,7 @@ CleanupChannelHandlers(interp, chanPtr)
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
ChannelEventScriptInvoker, (ClientData) sPtr);
- ckfree(sPtr->script);
+ Tcl_DecrRefCount(sPtr->scriptPtr);
ckfree((char *) sPtr);
} else {
prevPtr = sPtr;
@@ -4517,6 +5555,7 @@ Tcl_NotifyChannel(channel, mask)
{
Channel *chanPtr = (Channel *) channel;
ChannelHandler *chPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler nh;
/*
@@ -4543,8 +5582,8 @@ Tcl_NotifyChannel(channel, mask)
*/
nh.nextHandlerPtr = (ChannelHandler *) NULL;
- nh.nestedHandlerPtr = nestedHandlerPtr;
- nestedHandlerPtr = &nh;
+ nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
+ tsdPtr->nestedHandlerPtr = &nh;
for (chPtr = chanPtr->chPtr; chPtr != (ChannelHandler *) NULL; ) {
@@ -4573,7 +5612,7 @@ Tcl_NotifyChannel(channel, mask)
Tcl_Release((ClientData) channel);
- nestedHandlerPtr = nh.nestedHandlerPtr;
+ tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
/*
@@ -4609,14 +5648,14 @@ UpdateInterest(chanPtr)
}
/*
- * 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)
+ if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
&& (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
&& (chanPtr->inQueueHead->nextRemoved <
chanPtr->inQueueHead->nextAdded)) {
@@ -4653,7 +5692,7 @@ ChannelTimerProc(clientData)
{
Channel *chanPtr = (Channel *) clientData;
- if (!(chanPtr->flags & CHANNEL_GETS_BLOCKED)
+ if (!(chanPtr->flags & CHANNEL_NEED_MORE_DATA)
&& (chanPtr->interestMask & TCL_READABLE)
&& (chanPtr->inQueueHead != (ChannelBuffer *) NULL)
&& (chanPtr->inQueueHead->nextRemoved <
@@ -4789,6 +5828,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
{
ChannelHandler *chPtr, *prevChPtr;
Channel *chanPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
NextChannelHandler *nhPtr;
chanPtr = (Channel *) chan;
@@ -4820,7 +5860,7 @@ Tcl_DeleteChannelHandler(chan, proc, clientData)
* process the next one instead - we are going to delete *this* one.
*/
- for (nhPtr = nestedHandlerPtr;
+ for (nhPtr = tsdPtr->nestedHandlerPtr;
nhPtr != (NextChannelHandler *) NULL;
nhPtr = nhPtr->nestedHandlerPtr) {
if (nhPtr->nextHandlerPtr == chPtr) {
@@ -4841,7 +5881,8 @@ 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;
@@ -4896,7 +5937,7 @@ DeleteScriptRecord(interp, chanPtr, mask)
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
ChannelEventScriptInvoker, (ClientData) esPtr);
- ckfree(esPtr->script);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree((char *) esPtr);
break;
@@ -4922,15 +5963,14 @@ 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. */
{
EventScriptRecord *esPtr;
@@ -4938,8 +5978,8 @@ CreateScriptRecord(interp, chanPtr, mask, script)
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;
}
}
@@ -4954,8 +5994,8 @@ CreateScriptRecord(interp, chanPtr, mask, script)
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;
}
/*
@@ -4984,7 +6024,6 @@ ChannelEventScriptInvoker(clientData, mask)
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. */
@@ -4994,8 +6033,7 @@ ChannelEventScriptInvoker(clientData, mask)
chanPtr = esPtr->chanPtr;
mask = esPtr->mask;
interp = esPtr->interp;
- script = esPtr->script;
-
+
/*
* We must preserve the interpreter so we can report errors on it
* later. Note that we do not need to preserve the channel because
@@ -5003,7 +6041,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 +6063,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,46 +6081,38 @@ 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. */
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) {
Tcl_AppendResult(interp, "channel is not ",
@@ -5095,13 +6125,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;
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 +6142,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 +6153,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;
}
@@ -5164,7 +6194,7 @@ TclTestChannelCmd(clientData, interp, argc, argv)
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. */
+ char buf[TCL_INTEGER_SPACE];/* For sprintf. */
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -5175,6 +6205,7 @@ TclTestChannelCmd(clientData, interp, argc, argv)
len = strlen(cmdName);
chanPtr = (Channel *) NULL;
+
if (argc > 2) {
chan = Tcl_GetChannel(interp, argv[2], NULL);
if (chan == (Tcl_Channel) NULL) {
@@ -5182,7 +6213,8 @@ TclTestChannelCmd(clientData, interp, argc, argv)
}
chanPtr = (Channel *) chan;
}
-
+
+
if ((cmdName[0] == 'i') && (strncmp(cmdName, "info", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -5301,7 +6333,7 @@ TclTestChannelCmd(clientData, interp, argc, argv)
bufPtr = bufPtr->nextPtr) {
IOQueued += bufPtr->nextAdded - bufPtr->nextRemoved;
}
- sprintf(buf, "%d", IOQueued);
+ TclFormatInt(buf, IOQueued);
Tcl_AppendResult(interp, buf, (char *) NULL);
return TCL_OK;
}
@@ -5367,7 +6399,7 @@ TclTestChannelCmd(clientData, interp, argc, argv)
bufPtr = bufPtr->nextPtr) {
IOQueued += (bufPtr->nextAdded - bufPtr->nextRemoved);
}
- sprintf(buf, "%d", IOQueued);
+ TclFormatInt(buf, IOQueued);
Tcl_AppendResult(interp, buf, (char *) NULL);
return TCL_OK;
}
@@ -5409,7 +6441,7 @@ TclTestChannelCmd(clientData, interp, argc, argv)
return TCL_ERROR;
}
- sprintf(buf, "%d", chanPtr->refCount);
+ TclFormatInt(buf, chanPtr->refCount);
Tcl_AppendResult(interp, buf, (char *) NULL);
return TCL_OK;
}
@@ -5473,6 +6505,7 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
+ Tcl_Obj *resultListPtr;
Channel *chanPtr;
EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
char *cmd;
@@ -5515,8 +6548,8 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
esPtr->chanPtr = chanPtr;
esPtr->interp = interp;
esPtr->mask = mask;
- esPtr->script = ckalloc((unsigned) (strlen(argv[4]) + 1));
- strcpy(esPtr->script, argv[4]);
+ esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
+ Tcl_IncrRefCount(esPtr->scriptPtr);
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
ChannelEventScriptInvoker, (ClientData) esPtr);
@@ -5564,7 +6597,7 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
ChannelEventScriptInvoker, (ClientData) esPtr);
- ckfree(esPtr->script);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree((char *) esPtr);
return TCL_OK;
@@ -5576,19 +6609,20 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
" channelName list\"", (char *) NULL);
return TCL_ERROR;
}
+ resultListPtr = Tcl_GetObjResult(interp);
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_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
+ (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1));
+ } else {
+ Tcl_ListObjAppendElement(interp, resultListPtr,
+ Tcl_NewStringObj("none", -1));
}
- Tcl_AppendElement(interp, event);
- Tcl_AppendElement(interp, esPtr->script);
+ Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
}
+ Tcl_SetObjResult(interp, resultListPtr);
return TCL_OK;
}
@@ -5604,7 +6638,7 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
nextEsPtr = esPtr->nextPtr;
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
ChannelEventScriptInvoker, (ClientData) esPtr);
- ckfree(esPtr->script);
+ Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree((char *) esPtr);
}
chanPtr->scriptRecordPtr = (EventScriptRecord *) NULL;
@@ -5655,7 +6689,6 @@ TclTestChannelEventCmd(dummy, interp, argc, argv)
Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of ",
"add, delete, list, set, or removeall", (char *) NULL);
return TCL_ERROR;
-
}
/*
@@ -5946,7 +6979,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 +7001,477 @@ 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. */
+{
+ 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 (!(chanPtr->flags & CHANNEL_STICKY_EOF)) {
+ chanPtr->flags &= ~CHANNEL_EOF;
+ }
+ chanPtr->flags &= ~(CHANNEL_BLOCKED | CHANNEL_NEED_MORE_DATA);
+
+ for (copied = 0; copied < toRead; copied += copiedNow) {
+ copiedNow = CopyAndTranslateBuffer(chanPtr, bufPtr + copied,
+ toRead - copied);
+ if (copiedNow == 0) {
+ if (chanPtr->flags & CHANNEL_EOF) {
+ goto done;
+ }
+ if (chanPtr->flags & CHANNEL_BLOCKED) {
+ if (chanPtr->flags & CHANNEL_NONBLOCKING) {
+ goto done;
+ }
+ chanPtr->flags &= (~(CHANNEL_BLOCKED));
+ }
+ result = GetInput(chanPtr);
+ if (result != 0) {
+ if (result != EAGAIN) {
+ copied = -1;
+ }
+ goto done;
+ }
+ }
+ }
+
+ chanPtr->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(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? */
+{
+ 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. */
+ 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 (chanPtr->inQueueHead == (ChannelBuffer *) NULL) {
+ return 0;
+ }
+ bufPtr = chanPtr->inQueueHead;
+ bytesInBuffer = bufPtr->nextAdded - bufPtr->nextRemoved;
+
+ copied = 0;
+ switch (chanPtr->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 ((chanPtr->flags & (INPUT_SAW_CR | CHANNEL_EOF)) ==
+ (INPUT_SAW_CR | CHANNEL_EOF)) {
+ result[0] = '\r';
+ chanPtr->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') {
+ chanPtr->flags &= ~INPUT_SAW_CR;
+ } else if (chanPtr->flags & INPUT_SAW_CR) {
+ chanPtr->flags &= ~INPUT_SAW_CR;
+ *dst = '\r';
+ dst++;
+ }
+ if (curByte == '\r') {
+ chanPtr->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') {
+ chanPtr->flags |= INPUT_SAW_CR;
+ *dst = '\n';
+ dst++;
+ } else {
+ if ((curByte != '\n') ||
+ !(chanPtr->flags & INPUT_SAW_CR)) {
+ *dst = (char) curByte;
+ dst++;
+ }
+ chanPtr->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 (chanPtr->inEofChar != 0) {
+ for (i = 0; i < copied; i++) {
+ if (result[i] == (char) chanPtr->inEofChar) {
+ /*
+ * Set sticky EOF so that no further input is presented
+ * to the caller.
+ */
+
+ chanPtr->flags |= (CHANNEL_EOF | CHANNEL_STICKY_EOF);
+ chanPtr->inputEncodingFlags |= TCL_ENCODING_END;
+ copied = i;
+ break;
+ }
+ }
+ }
+
+ /*
+ * 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, 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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 (chanPtr->curOutPtr == (ChannelBuffer *) NULL) {
+ chanPtr->curOutPtr = AllocChannelBuffer(chanPtr->bufSize);
+ }
+
+ outBufPtr = chanPtr->curOutPtr;
+
+ destCopied = outBufPtr->bufLength - outBufPtr->nextAdded;
+ if (destCopied > srcLen) {
+ destCopied = srcLen;
+ }
+
+ destPtr = outBufPtr->buf + outBufPtr->nextAdded;
+ switch (chanPtr->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 (!(chanPtr->flags & BUFFER_READY)) {
+ if (outBufPtr->nextAdded == outBufPtr->bufLength) {
+ chanPtr->flags |= BUFFER_READY;
+ } else if (chanPtr->flags & CHANNEL_LINEBUFFERED) {
+ for (sPtr = src, 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;
+ src += srcCopied;
+ srcLen -= srcCopied;
+
+ if (chanPtr->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
@@ -6051,3 +7555,49 @@ StopCopy(csPtr)
csPtr->writePtr->csPtr = NULL;
ckfree((char*) csPtr);
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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;
+ }
+ return TCL_OK;
+}
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index b1ed0c8..f88840b 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -3,22 +3,16 @@
*
* 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.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.4 1999/02/02 22:25:42 stanton Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.5 1999/04/16 00:46:47 stanton Exp $
*/
-#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:
+ argerror:
Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numBytes?");
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), " or \"",
- Tcl_GetStringFromObj(objv[0], NULL),
+ 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,53 @@ 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. */
- }
+ resultPtr = Tcl_GetObjResult(interp);
+ charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
+ if (charactersRead < 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ 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;
- Tcl_SetObjResult(interp, resultPtr);
-
+ result = Tcl_GetStringFromObj(resultPtr, &length);
+ if (result[length - 1] == '\n') {
+ Tcl_SetObjLength(resultPtr, length - 1);
+ }
+ }
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 +395,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 +442,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 +458,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 +476,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 +511,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 +518,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 +528,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 +536,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 +554,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 +570,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 +601,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 +623,7 @@ Tcl_FconfigureCmd(clientData, interp, argc, argv)
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
* Tcl_EofObjCmd --
*
@@ -717,10 +634,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 +648,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 +657,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 +686,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 +751,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 +855,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 +869,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,20 +878,18 @@ 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;
}
@@ -965,35 +912,35 @@ Tcl_FblockedObjCmd(unused, interp, objc, objv)
/* ARGSUSED */
int
-Tcl_OpenObjCmd(notUsed, interp, argc, objv)
+Tcl_OpenObjCmd(notUsed, interp, objc, objv)
ClientData notUsed; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
- int argc; /* Number of arguments. */
- Tcl_Obj * CONST objv[]; /* Argument objects. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int pipeline, prot;
- char *modeString, *arg1;
+ char *modeString, *what;
Tcl_Channel chan;
- if ((argc < 2) || (argc > 4)) {
+ 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 = Tcl_GetStringFromObj(objv[2], NULL);
- if (argc == 4) {
+ modeString = Tcl_GetString(objv[2]);
+ if (objc == 4) {
if (Tcl_GetIntFromObj(interp, objv[3], &prot) != TCL_OK) {
return TCL_ERROR;
}
}
}
- arg1 = Tcl_GetStringFromObj(objv[1], NULL);
pipeline = 0;
- if (arg1[0] == '|') {
+ what = Tcl_GetString(objv[1]);
+ if (what[0] == '|') {
pipeline = 1;
}
@@ -1002,18 +949,18 @@ Tcl_OpenObjCmd(notUsed, interp, argc, objv)
*/
if (!pipeline) {
- chan = Tcl_OpenFileChannel(interp, arg1, modeString, prot);
+ chan = Tcl_OpenFileChannel(interp, what, modeString, prot);
} else {
#ifdef MAC_TCL
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ Tcl_AppendResult(interp,
"command pipelines not supported on Macintosh OS",
(char *)NULL);
return TCL_ERROR;
#else
- int mode, seekFlag, cmdArgc;
+ int mode, seekFlag, cmdObjc;
char **cmdArgv;
- if (Tcl_SplitList(interp, arg1+1, &cmdArgc, &cmdArgv) != TCL_OK) {
+ if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
return TCL_ERROR;
}
@@ -1036,7 +983,7 @@ Tcl_OpenObjCmd(notUsed, interp, argc, objv)
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
@@ -1045,8 +992,7 @@ Tcl_OpenObjCmd(notUsed, interp, argc, objv)
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
- Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- Tcl_GetChannelName(chan), (char *) NULL);
+ Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
return TCL_OK;
}
@@ -1218,7 +1164,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;
@@ -1315,7 +1261,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.
@@ -1330,13 +1276,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;
@@ -1347,66 +1299,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) {
@@ -1416,22 +1380,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 {
@@ -1510,10 +1475,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,
@@ -1526,25 +1491,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/generic/tclIOSock.c b/generic/tclIOSock.c
index 1f0be9e..3fb9e8d 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -3,19 +3,19 @@
*
* 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.
*
- * RCS: @(#) $Id: tclIOSock.c,v 1.2 1998/09/14 18:39:59 stanton Exp $
+ * RCS: @(#) $Id: tclIOSock.c,v 1.3 1999/04/16 00:46:47 stanton Exp $
*/
#include "tclInt.h"
#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;
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index c02738e..6a00e54 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -8,12 +8,12 @@
* 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.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.5 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.6 1999/04/16 00:46:47 stanton Exp $
*/
#include "tclInt.h"
@@ -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;
}
/*
@@ -468,7 +448,7 @@ TclStat(path, buf)
CONST char *path; /* Path of file to stat (in current CP). */
TclStat_ *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);
}
@@ -608,8 +597,10 @@ TclStatInsertProc (proc)
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);
}
@@ -706,8 +700,10 @@ TclAccessInsertProc(proc)
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);
}
@@ -806,8 +805,10 @@ TclOpenFileChannelInsertProc(proc)
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/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 2dc0d85..5acb6c5 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.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: tclIndexObj.c,v 1.2 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclIndexObj.c,v 1.3 1999/04/16 00:46:47 stanton Exp $
*/
#include "tclInt.h"
@@ -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,21 @@ 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++) {
+ 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;
@@ -135,13 +211,17 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
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 +235,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 +266,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 +318,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)) {
diff --git a/generic/tclInitScript.h b/generic/tclInitScript.h
index 25ce3a9..a1da091 100644
--- a/generic/tclInitScript.h
+++ b/generic/tclInitScript.h
@@ -3,106 +3,41 @@
*
* 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.
*
- * RCS: @(#) $Id: tclInitScript.h,v 1.8 1998/10/23 22:22:15 welch Exp $
+ * RCS: @(#) $Id: tclInitScript.h,v 1.9 1999/04/16 00:46:47 stanton Exp $
*/
/*
- * In order to find init.tcl during initialization, the following script
- * is invoked by Tcl_Init(). It looks in several different directories:
- *
- * $tcl_library - can specify a primary location, if set
- * no other locations will be checked
- *
- * $env(TCL_LIBRARY) - highest priority so user can always override
- * the search path unless the application has
- * specified an exact directory above
- *
- * $tclDefaultLibrary - this value is initialized by TclPlatformInit
- * 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
- *
- * The first directory on this path that contains a valid init.tcl script
- * will be set as the value of tcl_library.
- *
- * Note that this entire search mechanism can be bypassed by defining an
- * alternate tclInit procedure before calling Tcl_Init().
+ * The following string is the startup script executed in new
+ * interpreters. It looks on disk in several different directories
+ * 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 initScript[] = "if {[info proc tclInit]==\"\"} {\n\
proc tclInit {} {\n\
- global tcl_library tcl_version tcl_patchLevel errorInfo\n\
- global env tclDefaultLibrary\n\
+ global tcl_libPath tcl_library errorInfo\n\
rename tclInit {}\n\
set errors {}\n\
- set dirs {}\n\
- if {[info exists tcl_library]} {\n\
- lappend dirs $tcl_library\n\
- } else {\n\
- if {[info exists env(TCL_LIBRARY)]} {\n\
- lappend dirs $env(TCL_LIBRARY)\n\
- }\n\
- lappend dirs $tclDefaultLibrary\n\
- unset tclDefaultLibrary\n\
- set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
- lappend dirs [file join $parentDir lib tcl$tcl_version]\n\
- lappend dirs [file join [file dirname $parentDir] lib tcl$tcl_version]\n\
- lappend dirs [file join $parentDir library]\n\
- lappend dirs [file join [file dirname $parentDir] library]\n\
- if {[string match {*[ab]*} $tcl_patchLevel]} {\n\
- set ver $tcl_patchLevel\n\
- } else {\n\
- set ver $tcl_version\n\
- }\n\
- lappend dirs [file join [file dirname $parentDir] tcl$ver library]\n\
- lappend dirs [file join [file dirname [file dirname $parentDir]] tcl$ver library]\n\
- }\n\
- foreach i $dirs {\n\
+ foreach i $tcl_libPath {\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\
+ if {[catch {uplevel #0 [list source $tclfile]} msg] != 1} {\n\
+ return\n\
} else {\n\
append errors \"$tclfile: $msg\n$errorInfo\n\"\n\
}\n\
}\n\
}\n\
set msg \"Can't find a usable init.tcl in the following directories: \n\"\n\
- append msg \" $dirs\n\n\"\n\
+ append msg \" $tcl_libPath\n\n\"\n\
append msg \"$errors\n\n\"\n\
append msg \"This probably means that Tcl wasn't installed properly.\n\"\n\
error $msg\n\
@@ -110,6 +45,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/generic/tclInt.decls b/generic/tclInt.decls
index 29f755e..b2d1b44 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -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: tclInt.decls,v 1.4 1999/03/11 00:19:23 stanton Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.5 1999/04/16 00:46:47 stanton Exp $
library tcl
@@ -35,9 +35,10 @@ declare 2 generic {
declare 3 generic {
void TclAllocateFreeObjects(void)
}
-declare 4 generic {
- int TclChdir(Tcl_Interp *interp, char *dirName)
-}
+# Replaced by TclpChdir in 8.1:
+# declare 4 generic {
+# int TclChdir(Tcl_Interp *interp, char *dirName)
+# }
declare 5 generic {
int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, \
Tcl_Channel errorChan)
@@ -46,7 +47,7 @@ declare 6 generic {
void TclCleanupCommand(Command *cmdPtr)
}
declare 7 generic {
- int TclCopyAndCollapse(int count, char *src, char *dst)
+ int TclCopyAndCollapse(int count, CONST char *src, char *dst)
}
declare 8 generic {
int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, \
@@ -77,9 +78,10 @@ declare 13 generic {
declare 14 generic {
void TclDumpMemoryInfo(FILE *outFile)
}
-declare 15 generic {
- void TclExpandParseValue(ParseValue *pvPtr, int needed)
-}
+# Removed in 8.1:
+# declare 15 generic {
+# void TclExpandParseValue(ParseValue *pvPtr, int needed)
+# }
declare 16 generic {
void TclExprFloatError(Tcl_Interp *interp, double value)
}
@@ -99,8 +101,9 @@ declare 21 generic {
int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
}
declare 22 generic {
- int TclFindElement(Tcl_Interp *interp, char *list, int listLength, \
- char **elementPtr, char **nextPtr, int *sizePtr, int *bracePtr)
+ 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)
@@ -111,28 +114,30 @@ declare 24 generic {
declare 25 generic {
void TclFreePackageInfo(Interp *iPtr)
}
-declare 26 generic {
- char * TclGetCwd(Tcl_Interp *interp)
-}
+# 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 TclGetDefaultStdChannel(int type)
+ Tcl_Channel TclpGetDefaultStdChannel(int type)
}
declare 29 generic {
Tcl_Obj * TclGetElementOfIndexedArray(Tcl_Interp *interp, \
int localIndex, Tcl_Obj *elemPtr, int leaveErrorMsg)
}
-declare 30 generic {
- char * TclGetEnv(CONST char *name)
-}
+# 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 *string, CallFrame **framePtrPtr)
+ int TclGetFrame(Tcl_Interp *interp, char *str, CallFrame **framePtrPtr)
}
declare 33 generic {
TclCmdProcType TclGetInterpProc(void)
@@ -146,7 +151,7 @@ declare 35 generic {
int leaveErrorMsg)
}
declare 36 generic {
- int TclGetLong(Tcl_Interp *interp, char *string, long *longPtr)
+ int TclGetLong(Tcl_Interp *interp, char *str, long *longPtr)
}
declare 37 generic {
int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
@@ -161,13 +166,13 @@ declare 39 generic {
TclObjCmdProcType TclGetObjInterpProc(void)
}
declare 40 generic {
- int TclGetOpenMode(Tcl_Interp *interp, char *string, int *seekFlagPtr)
+ int TclGetOpenMode(Tcl_Interp *interp, char *str, int *seekFlagPtr)
}
declare 41 generic {
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 generic {
- char * TclGetUserHome(char *name, Tcl_DString *bufferPtr)
+ char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr)
}
declare 43 generic {
int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
@@ -214,21 +219,23 @@ declare 54 generic {
declare 55 generic {
Proc * TclIsProc(Command *cmdPtr)
}
-declare 56 generic {
- int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, \
- char *sym2, Tcl_PackageInitProc **proc1Ptr, \
- Tcl_PackageInitProc **proc2Ptr)
-}
-declare 57 generic {
- int TclLooksLikeInt(char *p)
-}
+# 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 TclMatchFiles(Tcl_Interp *interp, char *separators, \
+ int TclpMatchFiles(Tcl_Interp *interp, char *separators, \
Tcl_DString *dirPtr, char *pattern, char *tail)
}
declare 60 generic {
@@ -265,16 +272,17 @@ declare 69 generic {
char * TclpAlloc(unsigned int size)
}
declare 70 generic {
- int TclpCopyFile(char *source, char *dest)
+ int TclpCopyFile(CONST char *source, CONST char *dest)
}
declare 71 generic {
- int TclpCopyDirectory(char *source, char *dest, Tcl_DString *errorPtr)
+ int TclpCopyDirectory(CONST char *source, CONST char *dest, \
+ Tcl_DString *errorPtr)
}
declare 72 generic {
- int TclpCreateDirectory(char *path)
+ int TclpCreateDirectory(CONST char *path)
}
declare 73 generic {
- int TclpDeleteFile(char *path)
+ int TclpDeleteFile(CONST char *path)
}
declare 74 generic {
void TclpFree(char *ptr)
@@ -302,26 +310,28 @@ declare 81 generic {
char * TclpRealloc(char *ptr, unsigned int size)
}
declare 82 generic {
- int TclpRemoveDirectory(char *path, int recursive, Tcl_DString *errorPtr)
+ int TclpRemoveDirectory(CONST char *path, int recursive, \
+ Tcl_DString *errorPtr)
}
declare 83 generic {
- int TclpRenameFile(char *source, char *dest)
-}
-declare 84 generic {
- int TclParseBraces(Tcl_Interp *interp, char *string, char **termPtr, \
- ParseValue *pvPtr)
-}
-declare 85 generic {
- int TclParseNestedCmd(Tcl_Interp *interp, char *string, int flags, \
- char **termPtr, ParseValue *pvPtr)
-}
-declare 86 generic {
- int TclParseQuotes(Tcl_Interp *interp, char *string, int termChar, \
- int flags, char **termPtr, ParseValue *pvPtr)
-}
-declare 87 generic {
- void TclPlatformInit(Tcl_Interp *interp)
-}
+ 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)
@@ -330,9 +340,10 @@ declare 89 generic {
int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, \
Tcl_Command cmd)
}
-declare 90 generic {
- void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
-}
+# 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)
}
@@ -368,14 +379,15 @@ declare 100 generic {
Tcl_Obj * TclSetIndexedScalar(Tcl_Interp *interp, int localIndex, \
Tcl_Obj *objPtr, int leaveErrorMsg)
}
-declare 101 generic {
- char * TclSetPreInitScript(char *string)
-}
+# TODO: needs to be implemented
+# declare 101 generic {
+# char * TclSetPreInitScript(char *string)
+# }
declare 102 generic {
void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 generic {
- int TclSockGetPort(Tcl_Interp *interp, char *string, char *proto, \
+ int TclSockGetPort(Tcl_Interp *interp, char *str, char *proto, \
int *portPtr)
}
declare 104 generic {
@@ -396,9 +408,10 @@ declare 108 generic {
declare 109 generic {
int TclUpdateReturnInfo(Interp *iPtr)
}
-declare 110 generic {
- char * TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr)
-}
+# 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.
@@ -484,19 +497,39 @@ declare 131 generic {
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 132 generic {
- int TclHasSockets(Tcl_Interp *interp)
+ int TclpHasSockets(Tcl_Interp *interp)
}
declare 133 generic {
struct tm * TclpGetDate(TclpTime_t time, int useGMT)
}
declare 134 generic {
- size_t TclStrftime(char *s, size_t maxsize, const char *format, \
- const struct tm *t)
+ 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)
+}
##############################################################################
# Define the platform specific internal Tcl interface. These functions are
@@ -517,7 +550,7 @@ declare 2 mac {
VOID * TclpSysRealloc(VOID *cp, unsigned int size)
}
declare 3 mac {
- void TclPlatformExit(int status)
+ void TclpExit(int status)
}
# Prototypes for functions found in the tclMacUtil.c compatability library.
@@ -541,15 +574,15 @@ declare 7 mac {
# however. The first set are from the MoreFiles package.
declare 8 mac {
- pascal OSErr FSpGetDirectoryID(const FSSpec *spec, long *theDirID, \
+ pascal OSErr FSpGetDirectoryID(CONST FSSpec *spec, long *theDirID, \
Boolean *isDirectory)
}
declare 9 mac {
- pascal short FSpOpenResFileCompat(const FSSpec *spec, \
+ pascal short FSpOpenResFileCompat(CONST FSSpec *spec, \
SignedByte permission)
}
declare 10 mac {
- pascal void FSpCreateResFileCompat(const FSSpec *spec, OSType creator, \
+ pascal void FSpCreateResFileCompat(CONST FSSpec *spec, OSType creator, \
OSType fileType, ScriptCode scriptTag)
}
@@ -598,16 +631,16 @@ declare 22 mac {
int TclMacCreateEnv(void)
}
declare 23 mac {
- FILE * TclMacFOpenHack(const char *path, const char *mode)
-}
-declare 24 mac {
- int TclMacReadlink(char *path, char *buf, int size)
+ 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
@@ -618,8 +651,8 @@ declare 1 win {
void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
- struct servent * TclWinGetServByName(const char *nm, \
- const char *proto)
+ struct servent * TclWinGetServByName(CONST char *nm, \
+ CONST char *proto)
}
declare 3 win {
int TclWinGetSockOpt(SOCKET s, int level, int optname, \
@@ -628,15 +661,16 @@ declare 3 win {
declare 4 win {
HINSTANCE TclWinGetTclInstance(void)
}
-declare 5 win {
- HINSTANCE TclWinLoadLibrary(char *name)
-}
+# 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)
+ CONST char FAR * optval, int optlen)
}
declare 8 win {
unsigned long TclpGetPid(Tcl_Pid pid)
@@ -668,18 +702,18 @@ declare 15 win {
TclFile inputFile, TclFile outputFile, TclFile errorFile, \
Tcl_Pid *pidPtr)
}
-declare 16 win {
- TclFile TclpCreateTempFile(char *contents,
- Tcl_DString *namePtr)
-}
-declare 17 win {
- char * TclpGetTZName(void)
-}
+# 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(char *fname, int mode)
+ TclFile TclpOpenFile(CONST char *fname, int mode)
}
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
@@ -688,6 +722,17 @@ 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)
+}
+
#########################
# Unix specific internals
@@ -711,16 +756,23 @@ declare 4 unix {
TclFile inputFile, TclFile outputFile, TclFile errorFile, \
Tcl_Pid *pidPtr)
}
-declare 5 unix {
- TclFile TclpCreateTempFile(char *contents,
- Tcl_DString *namePtr)
-}
+# 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(char *fname, int mode)
+ 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/generic/tclInt.h b/generic/tclInt.h
index 65ec24a..0590bc5 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -4,14 +4,14 @@
* 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) 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.
*
- * RCS: @(#) $Id: tclInt.h,v 1.24 1999/03/10 05:52:48 stanton Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.25 1999/04/16 00:46:48 stanton Exp $
*/
#ifndef _TCLINT
@@ -32,9 +32,6 @@
#ifndef _TCL
#include "tcl.h"
#endif
-#ifndef _REGEXP
-#include "tclRegexp.h"
-#endif
#include <ctype.h>
#ifdef NO_LIMITS_H
@@ -101,8 +98,8 @@ 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
@@ -266,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;
@@ -696,6 +693,21 @@ typedef struct CallFrame {
/*
*----------------------------------------------------------------
+ * 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;
+
+TclHandle TclHandleCreate _ANSI_ARGS_((VOID *ptr));
+void TclHandleFree _ANSI_ARGS_((TclHandle handle));
+TclHandle TclHandlePreserve _ANSI_ARGS_((TclHandle handle));
+void TclHandleRelease _ANSI_ARGS_((TclHandle handle));
+
+/*
+ *----------------------------------------------------------------
* Data structures related to history. These are used primarily
* in tclHistory.c
*----------------------------------------------------------------
@@ -764,6 +776,27 @@ 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))
+
+
+#ifdef MAC_TCL
+typedef pascal void *(Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#else
+typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
+#endif
+
+/*
*----------------------------------------------------------------
* Data structures related to bytecode compilation and execution.
* These are used primarily in tclCompile.c, tclExecute.c, and
@@ -772,11 +805,12 @@ 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 Tcl_Parse;
struct CompileEnv;
/*
@@ -798,8 +832,8 @@ 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,
+ struct Tcl_Parse *parsePtr, struct CompileEnv *compEnvPtr));
/*
* The data structure defining the execution environment for ByteCode's.
@@ -811,14 +845,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. */
@@ -826,56 +854,91 @@ typedef struct ExecEnv {
} ExecEnv;
/*
- * CompileProcs need the ability to record information during compilation
- * that can be used by bytecode instructions during execution. The AuxData
- * structure provides this "auxiliary data" mechanism. An arbitrary number
- * of these structures can be stored in the ByteCode record (during
- * compilation they are stored in a CompileEnv structure). Each AuxData
- * record holds one word of client-specified data (often a pointer) and is
- * given an index that instructions can later use to look up the structure
- * and its data.
+ * 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.
*
- * The following definitions declare the types of procedures that are called
- * to duplicate or free this auxiliary data when the containing ByteCode
- * objects are duplicated and freed. Pointers to these procedures are kept
- * in the AuxData structure.
- */
-
-typedef ClientData (AuxDataDupProc) _ANSI_ARGS_((ClientData clientData));
-typedef void (AuxDataFreeProc) _ANSI_ARGS_((ClientData clientData));
-
-/*
- * We define a separate AuxDataType struct to hold type-related information
- * for the AuxData structure. This separation makes it possible for clients
- * outside of the TCL core to manipulate (in a limited fashion!) AuxData;
- * for example, it makes it possible to pickle and unpickle AuxData structs.
- */
-
-typedef struct AuxDataType {
- char *name; /* the name of the type. Types can be
- * registered and found by name */
- AuxDataDupProc *dupProc; /* Callback procedure to invoke when the
- * aux data is duplicated (e.g., when the
- * ByteCode structure containing the aux
- * data is duplicated). NULL means just
- * copy the source clientData bits; no
- * proc need be called. */
- AuxDataFreeProc *freeProc; /* Callback procedure to invoke when the
- * aux data is freed. NULL means no
- * proc need be called. */
-} AuxDataType;
-
-/*
- * The definition of the AuxData structure that holds information created
- * during compilation by CompileProcs and used by instructions during
- * execution.
+ * 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.
*/
-typedef struct AuxData {
- AuxDataType *type; /* pointer to the AuxData type associated with
- * this ClientData. */
- ClientData clientData; /* The compilation data itself. */
-} AuxData;
+#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 */
/*
*----------------------------------------------------------------
@@ -1049,12 +1112,25 @@ typedef struct Interp {
* 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
* strings (function names); values have
* type (MathFunc *). */
+
+
/*
* Information related to procedures and variables. See tclProc.c
* and tclvar.c for usage.
@@ -1101,7 +1177,10 @@ typedef struct Interp {
/*
* A cache of compiled regular expressions. See Tcl_RegExpCompile
- * in tclUtil.c for details.
+ * in tclUtil.c for details. THIS CACHE IS OBSOLETE and is only
+ * retained for backward compatibility with Tcl_RegExpCompile.
+ * New code should use the object interface so the Tcl_Obj caches
+ * the compiled expression.
*/
#define NUM_REGEXPS 5
@@ -1112,7 +1191,7 @@ typedef struct Interp {
int patLengths[NUM_REGEXPS];/* Number of non-null characters in
* corresponding entry in patterns.
* -1 means entry isn't used. */
- regexp *regexps[NUM_REGEXPS];
+ struct TclRegexp *regexps[NUM_REGEXPS];
/* Compiled forms of above strings. Also
* malloc-ed, or NULL if not in use yet. */
@@ -1141,6 +1220,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
@@ -1155,7 +1240,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
@@ -1180,6 +1265,17 @@ typedef struct Interp {
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;
/*
@@ -1225,16 +1321,21 @@ typedef struct Interp {
* 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 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
/*
*----------------------------------------------------------------
@@ -1266,48 +1367,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
@@ -1359,10 +1418,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
@@ -1379,6 +1443,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
@@ -1388,11 +1453,9 @@ 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. */
@@ -1440,6 +1503,8 @@ typedef struct TclpTime_t_ *TclpTime_t;
extern Tcl_Time tclBlockTime;
extern int tclBlockTimeSet;
extern char * tclExecutableName;
+extern char * tclNativeExecutableName;
+extern char * tclDefaultEncodingDir;
extern Tcl_ChannelType tclFileChannelType;
extern char * tclMemDumpFileName;
extern TclPlatformType tclPlatform;
@@ -1481,46 +1546,283 @@ extern char * tclEmptyStringRep;
/*
*----------------------------------------------------------------
- * Declarations of procedures that are not accessible by way of
- * the stubs tables.
+ * Procedures shared among Tcl modules but not used by the outside
+ * world:
*----------------------------------------------------------------
*/
-EXTERN int TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *lastChar, int compileFlags,
- struct CompileEnv *compileEnvPtr));
-EXTERN void TclFinalizeCompExecEnv _ANSI_ARGS_((void));
-EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void));
-EXTERN void TclFinalizeExecEnv _ANSI_ARGS_((void));
-EXTERN void TclInitNamespaces _ANSI_ARGS_((void));
-EXTERN void TclpFinalize _ANSI_ARGS_((void));
+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 TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
+EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
+ int numPids, Tcl_Pid *pidPtr,
+ Tcl_Channel errorChan));
+EXTERN void TclCleanupCommand _ANSI_ARGS_((Command *cmdPtr));
+EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel inChan, Tcl_Channel outChan,
+ int toRead, Tcl_Obj *cmdPtr));
+/*
+ * TclCreatePipeline unofficially exported for use by BLT.
+ */
+EXTERN int TclCreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
+ int argc, char **argv, Tcl_Pid **pidArrayPtr,
+ TclFile *inPipePtr, TclFile *outPipePtr,
+ TclFile *errFilePtr));
+EXTERN int TclCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Namespace *nsPtr, char *procName,
+ Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr,
+ Proc **procPtrPtr));
+EXTERN void TclDeleteCompiledLocalVars _ANSI_ARGS_((
+ 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));
+EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE *outFile));
+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,
+ 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 TclFinalizeCondition _ANSI_ARGS_((
+ Tcl_Condition *condPtr));
+EXTERN void TclFinalizeCompilation _ANSI_ARGS_((void));
+EXTERN void TclFinalizeEncodingSubsystem _ANSI_ARGS_((void));
+EXTERN void TclFinalizeEnvironment _ANSI_ARGS_((void));
+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 TclFinalizeMutex _ANSI_ARGS_((Tcl_Mutex *mutex));
+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 int TclGetDate _ANSI_ARGS_((char *p,
+ unsigned long now, long zone,
+ unsigned long *timePtr));
+EXTERN Tcl_Obj * TclGetElementOfIndexedArray _ANSI_ARGS_((
+ Tcl_Interp *interp, int localIndex,
+ Tcl_Obj *elemPtr, int leaveErrorMsg));
+EXTERN char * TclGetExtension _ANSI_ARGS_((char *name));
+EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, CallFrame **framePtrPtr));
+EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
+EXTERN int TclGetIntForIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, int endValue, int *indexPtr));
+EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
+ int localIndex, int leaveErrorMsg));
+EXTERN Tcl_Obj * TclGetLibraryPath _ANSI_ARGS_((void));
+EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, long *longPtr));
+EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
+ Tcl_Interp *interp, char *targetName));
+EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
+ Tcl_Interp *interp, char *qualName,
+ Namespace *cxtNsPtr, int flags,
+ Namespace **nsPtrPtr, Namespace **altNsPtrPtr,
+ Namespace **actualCxtPtrPtr,
+ char **simpleNamePtr));
+EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
+EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, int *seekFlagPtr));
+EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
+ Tcl_Command command));
+EXTERN int TclGlob _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pattern, int noComplain));
+EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+ int argc, char **argv, int flags));
+EXTERN int TclGuessPackageName _ANSI_ARGS_((char *fileName,
+ Tcl_DString *bufPtr));
+EXTERN int TclHideUnsafeCommands _ANSI_ARGS_((
+ Tcl_Interp *interp));
+EXTERN int TclInExit _ANSI_ARGS_((void));
+EXTERN Tcl_Obj * TclIncrElementOfIndexedArray _ANSI_ARGS_((
+ Tcl_Interp *interp, int localIndex,
+ Tcl_Obj *elemPtr, long incrAmount));
+EXTERN Tcl_Obj * TclIncrIndexedScalar _ANSI_ARGS_((
+ 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 flags));
+EXTERN void TclInitAlloc _ANSI_ARGS_((void));
+EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
+ Tcl_Interp *interp, CallFrame *framePtr,
+ Namespace *nsPtr));
+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));
+EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
+ 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[]));
+EXTERN int TclIsLocalScalar _ANSI_ARGS_((CONST char *src,
+ int len));
+EXTERN Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr));
+EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
+ char *part1, char *part2, int flags, char *msg,
+ int createPart1, int createPart2,
+ Var **arrayPtrPtr));
+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_Obj *CONST objv[]));
+EXTERN int TclObjInvoke _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[], int flags));
+EXTERN int TclObjInvokeGlobal _ANSI_ARGS_((Tcl_Interp *interp,
+ 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));
+EXTERN int TclpCheckStackSpace _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 * 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 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 void TclpReleaseFile _ANSI_ARGS_((TclFile file));
+EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char *path,
+ int recursive, Tcl_DString *errorPtr));
+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));
+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 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));
+EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
+EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int TclpThreadCreate _ANSI_ARGS_((Tcl_ThreadId *idPtr,
+ Tcl_ThreadCreateProc proc, ClientData clientData));
+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_Obj *elemPtr, Tcl_Obj *objPtr,
+ int leaveErrorMsg));
+EXTERN void TclSetLibraryPath _ANSI_ARGS_((Tcl_Obj *pathPtr));
+EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp *interp,
+ int localIndex, Tcl_Obj *objPtr,
+ int leaveErrorMsg));
+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));
+EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
+ int size));
+EXTERN int TclStat _ANSI_ARGS_((CONST char *path,
+ TclStat_ *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));
/*
*----------------------------------------------------------------
@@ -1536,8 +1838,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,
@@ -1550,34 +1852,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,
@@ -1586,16 +1890,16 @@ 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,
- Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+ Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_JoinObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_LappendObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -1608,8 +1912,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,
@@ -1622,64 +1926,64 @@ EXTERN int Tcl_NamespaceObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_OpenObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
-EXTERN int Tcl_PackageCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+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_ProcObjCmd _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[]));
/*
*----------------------------------------------------------------
@@ -1688,29 +1992,44 @@ 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_MacSourceObjCmd _ANSI_ARGS_((ClientData clientData,
+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,
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[]));
#endif
-
/*
*----------------------------------------------------------------
- * Command procedures used for testing.
+ * Compilation procedures for commands in the generic core:
*----------------------------------------------------------------
*/
-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 int TclCompileBreakCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileCatchCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileContinueCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileExprCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
+EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
/*
*----------------------------------------------------------------
@@ -1742,12 +2061,14 @@ EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
#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; \
@@ -1755,24 +2076,32 @@ EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
(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(); \
} \
@@ -1783,20 +2112,24 @@ EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
(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 */
@@ -1816,12 +2149,12 @@ EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
#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); \
}
@@ -1829,64 +2162,18 @@ EXTERN int TclTestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
/*
*----------------------------------------------------------------
* 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:
+ * 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 char * TclGetStringFromObj _ANSI_ARGS_((Tcl_Obj *objPtr,
- * int *lengthPtr));
+ * EXTERN char * TclGetString _ANSI_ARGS_((Tcl_Obj *objPtr));
*----------------------------------------------------------------
*/
-#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.
- * 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; \
- } \
- }
-
-/*
- * Include the declarations for functions that are accessible via
- * the stubs table.
- */
+#define TclGetString(objPtr) \
+ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
#include "tclIntDecls.h"
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index ec8b39a..a2b2ac2 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIntDecls.h,v 1.3 1999/03/10 05:52:48 stanton Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.4 1999/04/16 00:46:48 stanton Exp $
*/
#ifndef _TCLINTDECLS
@@ -39,9 +39,7 @@ EXTERN int TclAccessInsertProc _ANSI_ARGS_((
TclAccessProc_ * proc));
/* 3 */
EXTERN void TclAllocateFreeObjects _ANSI_ARGS_((void));
-/* 4 */
-EXTERN int TclChdir _ANSI_ARGS_((Tcl_Interp * interp,
- char * dirName));
+/* Slot 4 is reserved */
/* 5 */
EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp,
int numPids, Tcl_Pid * pidPtr,
@@ -50,7 +48,7 @@ EXTERN int TclCleanupChildren _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void TclCleanupCommand _ANSI_ARGS_((Command * cmdPtr));
/* 7 */
EXTERN int TclCopyAndCollapse _ANSI_ARGS_((int count,
- char * src, char * dst));
+ CONST char * src, char * dst));
/* 8 */
EXTERN int TclCopyChannel _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Channel inChan, Tcl_Channel outChan,
@@ -77,9 +75,7 @@ EXTERN int TclDoGlob _ANSI_ARGS_((Tcl_Interp * interp,
char * tail));
/* 14 */
EXTERN void TclDumpMemoryInfo _ANSI_ARGS_((FILE * outFile));
-/* 15 */
-EXTERN void TclExpandParseValue _ANSI_ARGS_((ParseValue * pvPtr,
- int needed));
+/* Slot 15 is reserved */
/* 16 */
EXTERN void TclExprFloatError _ANSI_ARGS_((Tcl_Interp * interp,
double value));
@@ -100,9 +96,10 @@ EXTERN int TclFileRenameCmd _ANSI_ARGS_((Tcl_Interp * interp,
int argc, char ** argv));
/* 22 */
EXTERN int TclFindElement _ANSI_ARGS_((Tcl_Interp * interp,
- char * list, int listLength,
- char ** elementPtr, char ** nextPtr,
- int * sizePtr, int * bracePtr));
+ 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));
@@ -110,24 +107,22 @@ EXTERN Proc * TclFindProc _ANSI_ARGS_((Interp * iPtr,
EXTERN int TclFormatInt _ANSI_ARGS_((char * buffer, long n));
/* 25 */
EXTERN void TclFreePackageInfo _ANSI_ARGS_((Interp * iPtr));
-/* 26 */
-EXTERN char * TclGetCwd _ANSI_ARGS_((Tcl_Interp * interp));
+/* Slot 26 is reserved */
/* 27 */
EXTERN int TclGetDate _ANSI_ARGS_((char * p, unsigned long now,
long zone, unsigned long * timePtr));
/* 28 */
-EXTERN Tcl_Channel TclGetDefaultStdChannel _ANSI_ARGS_((int type));
+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));
-/* 30 */
-EXTERN char * TclGetEnv _ANSI_ARGS_((CONST char * name));
+/* Slot 30 is reserved */
/* 31 */
EXTERN char * TclGetExtension _ANSI_ARGS_((char * name));
/* 32 */
EXTERN int TclGetFrame _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, CallFrame ** framePtrPtr));
+ char * str, CallFrame ** framePtrPtr));
/* 33 */
EXTERN TclCmdProcType TclGetInterpProc _ANSI_ARGS_((void));
/* 34 */
@@ -139,7 +134,7 @@ EXTERN Tcl_Obj * TclGetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp,
int localIndex, int leaveErrorMsg));
/* 36 */
EXTERN int TclGetLong _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, long * longPtr));
+ char * str, long * longPtr));
/* 37 */
EXTERN int TclGetLoadedPackages _ANSI_ARGS_((
Tcl_Interp * interp, char * targetName));
@@ -155,12 +150,12 @@ EXTERN int TclGetNamespaceForQualName _ANSI_ARGS_((
EXTERN TclObjCmdProcType TclGetObjInterpProc _ANSI_ARGS_((void));
/* 40 */
EXTERN int TclGetOpenMode _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int * seekFlagPtr));
+ char * str, int * seekFlagPtr));
/* 41 */
EXTERN Tcl_Command TclGetOriginalCommand _ANSI_ARGS_((
Tcl_Command command));
/* 42 */
-EXTERN char * TclGetUserHome _ANSI_ARGS_((char * name,
+EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name,
Tcl_DString * bufferPtr));
/* 43 */
EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp,
@@ -204,20 +199,15 @@ EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
int objc, Tcl_Obj *CONST objv[]));
/* 55 */
EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr));
-/* 56 */
-EXTERN int TclLoadFile _ANSI_ARGS_((Tcl_Interp * interp,
- char * fileName, char * sym1, char * sym2,
- Tcl_PackageInitProc ** proc1Ptr,
- Tcl_PackageInitProc ** proc2Ptr));
-/* 57 */
-EXTERN int TclLooksLikeInt _ANSI_ARGS_((char * p));
+/* 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 TclMatchFiles _ANSI_ARGS_((Tcl_Interp * interp,
+EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp * interp,
char * separators, Tcl_DString * dirPtr,
char * pattern, char * tail));
/* 60 */
@@ -247,14 +237,15 @@ 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_((char * source, char * dest));
+EXTERN int TclpCopyFile _ANSI_ARGS_((CONST char * source,
+ CONST char * dest));
/* 71 */
-EXTERN int TclpCopyDirectory _ANSI_ARGS_((char * source,
- char * dest, Tcl_DString * errorPtr));
+EXTERN int TclpCopyDirectory _ANSI_ARGS_((CONST char * source,
+ CONST char * dest, Tcl_DString * errorPtr));
/* 72 */
-EXTERN int TclpCreateDirectory _ANSI_ARGS_((char * path));
+EXTERN int TclpCreateDirectory _ANSI_ARGS_((CONST char * path));
/* 73 */
-EXTERN int TclpDeleteFile _ANSI_ARGS_((char * path));
+EXTERN int TclpDeleteFile _ANSI_ARGS_((CONST char * path));
/* 74 */
EXTERN void TclpFree _ANSI_ARGS_((char * ptr));
/* 75 */
@@ -275,25 +266,15 @@ EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr,
unsigned int size));
/* 82 */
-EXTERN int TclpRemoveDirectory _ANSI_ARGS_((char * path,
+EXTERN int TclpRemoveDirectory _ANSI_ARGS_((CONST char * path,
int recursive, Tcl_DString * errorPtr));
/* 83 */
-EXTERN int TclpRenameFile _ANSI_ARGS_((char * source,
- char * dest));
-/* 84 */
-EXTERN int TclParseBraces _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, char ** termPtr,
- ParseValue * pvPtr));
-/* 85 */
-EXTERN int TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int flags, char ** termPtr,
- ParseValue * pvPtr));
-/* 86 */
-EXTERN int TclParseQuotes _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int termChar, int flags,
- char ** termPtr, ParseValue * pvPtr));
-/* 87 */
-EXTERN void TclPlatformInit _ANSI_ARGS_((Tcl_Interp * interp));
+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,
@@ -301,9 +282,7 @@ EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
/* 89 */
EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Interp * cmdInterp, Tcl_Command cmd));
-/* 90 */
-EXTERN void TclPrintByteCodeObj _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Obj * objPtr));
+/* Slot 90 is reserved */
/* 91 */
EXTERN void TclProcCleanupProc _ANSI_ARGS_((Proc * procPtr));
/* 92 */
@@ -336,13 +315,12 @@ EXTERN Tcl_Obj * TclSetElementOfIndexedArray _ANSI_ARGS_((
EXTERN Tcl_Obj * TclSetIndexedScalar _ANSI_ARGS_((Tcl_Interp * interp,
int localIndex, Tcl_Obj * objPtr,
int leaveErrorMsg));
-/* 101 */
-EXTERN char * TclSetPreInitScript _ANSI_ARGS_((char * string));
+/* Slot 101 is reserved */
/* 102 */
EXTERN void TclSetupEnv _ANSI_ARGS_((Tcl_Interp * interp));
/* 103 */
EXTERN int TclSockGetPort _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, char * proto, int * portPtr));
+ char * str, char * proto, int * portPtr));
/* 104 */
EXTERN int TclSockMinimumBuffers _ANSI_ARGS_((int sock,
int size));
@@ -357,9 +335,7 @@ EXTERN int TclStatInsertProc _ANSI_ARGS_((TclStatProc_ * proc));
EXTERN void TclTeardownNamespace _ANSI_ARGS_((Namespace * nsPtr));
/* 109 */
EXTERN int TclUpdateReturnInfo _ANSI_ARGS_((Interp * iPtr));
-/* 110 */
-EXTERN char * TclWordEnd _ANSI_ARGS_((char * start,
- char * lastChar, int nested, int * semiPtr));
+/* Slot 110 is reserved */
/* 111 */
EXTERN void Tcl_AddInterpResolvers _ANSI_ARGS_((
Tcl_Interp * interp, char * name,
@@ -441,14 +417,32 @@ EXTERN void Tcl_SetNamespaceResolvers _ANSI_ARGS_((
Tcl_ResolveVarProc * varProc,
Tcl_ResolveCompiledVarProc * compiledVarProc));
/* 132 */
-EXTERN int TclHasSockets _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN int TclpHasSockets _ANSI_ARGS_((Tcl_Interp * interp));
/* 133 */
EXTERN struct tm * TclpGetDate _ANSI_ARGS_((TclpTime_t time, int useGMT));
/* 134 */
-EXTERN size_t TclStrftime _ANSI_ARGS_((char * s, size_t maxsize,
- const char * format, const struct tm * t));
+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));
typedef struct TclIntStubs {
int magic;
@@ -458,10 +452,10 @@ typedef struct TclIntStubs {
int (*tclAccessDeleteProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 1 */
int (*tclAccessInsertProc) _ANSI_ARGS_((TclAccessProc_ * proc)); /* 2 */
void (*tclAllocateFreeObjects) _ANSI_ARGS_((void)); /* 3 */
- int (*tclChdir) _ANSI_ARGS_((Tcl_Interp * interp, char * dirName)); /* 4 */
+ void *reserved4;
int (*tclCleanupChildren) _ANSI_ARGS_((Tcl_Interp * interp, int numPids, Tcl_Pid * pidPtr, Tcl_Channel errorChan)); /* 5 */
void (*tclCleanupCommand) _ANSI_ARGS_((Command * cmdPtr)); /* 6 */
- int (*tclCopyAndCollapse) _ANSI_ARGS_((int count, char * src, char * dst)); /* 7 */
+ 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 */
int (*tclCreatePipeline) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, Tcl_Pid ** pidArrayPtr, TclFile * inPipePtr, TclFile * outPipePtr, TclFile * errFilePtr)); /* 9 */
int (*tclCreateProc) _ANSI_ARGS_((Tcl_Interp * interp, Namespace * nsPtr, char * procName, Tcl_Obj * argsPtr, Tcl_Obj * bodyPtr, Proc ** procPtrPtr)); /* 10 */
@@ -469,34 +463,34 @@ typedef struct TclIntStubs {
void (*tclDeleteVars) _ANSI_ARGS_((Interp * iPtr, Tcl_HashTable * tablePtr)); /* 12 */
int (*tclDoGlob) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * headPtr, char * tail)); /* 13 */
void (*tclDumpMemoryInfo) _ANSI_ARGS_((FILE * outFile)); /* 14 */
- void (*tclExpandParseValue) _ANSI_ARGS_((ParseValue * pvPtr, int needed)); /* 15 */
+ 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, char * list, int listLength, char ** elementPtr, char ** nextPtr, int * sizePtr, int * bracePtr)); /* 22 */
+ 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 */
- char * (*tclGetCwd) _ANSI_ARGS_((Tcl_Interp * interp)); /* 26 */
+ void *reserved26;
int (*tclGetDate) _ANSI_ARGS_((char * p, unsigned long now, long zone, unsigned long * timePtr)); /* 27 */
- Tcl_Channel (*tclGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
+ Tcl_Channel (*tclpGetDefaultStdChannel) _ANSI_ARGS_((int type)); /* 28 */
Tcl_Obj * (*tclGetElementOfIndexedArray) _ANSI_ARGS_((Tcl_Interp * interp, int localIndex, Tcl_Obj * elemPtr, int leaveErrorMsg)); /* 29 */
- char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name)); /* 30 */
+ void *reserved30;
char * (*tclGetExtension) _ANSI_ARGS_((char * name)); /* 31 */
- int (*tclGetFrame) _ANSI_ARGS_((Tcl_Interp * interp, char * string, CallFrame ** framePtrPtr)); /* 32 */
+ 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 * string, long * longPtr)); /* 36 */
+ 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 * string, int * seekFlagPtr)); /* 40 */
+ int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, char * str, int * seekFlagPtr)); /* 40 */
Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */
- char * (*tclGetUserHome) _ANSI_ARGS_((char * name, Tcl_DString * bufferPtr)); /* 42 */
+ 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 */
@@ -510,10 +504,10 @@ typedef struct TclIntStubs {
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 */
- int (*tclLoadFile) _ANSI_ARGS_((Tcl_Interp * interp, char * fileName, char * sym1, char * sym2, Tcl_PackageInitProc ** proc1Ptr, Tcl_PackageInitProc ** proc2Ptr)); /* 56 */
- int (*tclLooksLikeInt) _ANSI_ARGS_((char * p)); /* 57 */
+ 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 (*tclMatchFiles) _ANSI_ARGS_((Tcl_Interp * interp, char * separators, Tcl_DString * dirPtr, char * pattern, char * tail)); /* 59 */
+ 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 */
@@ -524,10 +518,10 @@ typedef struct TclIntStubs {
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_((char * source, char * dest)); /* 70 */
- int (*tclpCopyDirectory) _ANSI_ARGS_((char * source, char * dest, Tcl_DString * errorPtr)); /* 71 */
- int (*tclpCreateDirectory) _ANSI_ARGS_((char * path)); /* 72 */
- int (*tclpDeleteFile) _ANSI_ARGS_((char * path)); /* 73 */
+ 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 */
@@ -536,15 +530,15 @@ typedef struct TclIntStubs {
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_((char * path, int recursive, Tcl_DString * errorPtr)); /* 82 */
- int (*tclpRenameFile) _ANSI_ARGS_((char * source, char * dest)); /* 83 */
- int (*tclParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char ** termPtr, ParseValue * pvPtr)); /* 84 */
- int (*tclParseNestedCmd) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int flags, char ** termPtr, ParseValue * pvPtr)); /* 85 */
- int (*tclParseQuotes) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int termChar, int flags, char ** termPtr, ParseValue * pvPtr)); /* 86 */
- void (*tclPlatformInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 87 */
+ 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 (*tclPrintByteCodeObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 90 */
+ 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 */
@@ -555,16 +549,16 @@ typedef struct TclIntStubs {
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 */
- char * (*tclSetPreInitScript) _ANSI_ARGS_((char * string)); /* 101 */
+ void *reserved101;
void (*tclSetupEnv) _ANSI_ARGS_((Tcl_Interp * interp)); /* 102 */
- int (*tclSockGetPort) _ANSI_ARGS_((Tcl_Interp * interp, char * string, char * proto, int * portPtr)); /* 103 */
+ int (*tclSockGetPort) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char * proto, int * portPtr)); /* 103 */
int (*tclSockMinimumBuffers) _ANSI_ARGS_((int sock, int size)); /* 104 */
int (*tclStat) _ANSI_ARGS_((CONST char * path, TclStat_ * 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 */
- char * (*tclWordEnd) _ANSI_ARGS_((char * start, char * lastChar, int nested, int * semiPtr)); /* 110 */
+ 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 */
@@ -586,10 +580,16 @@ typedef struct TclIntStubs {
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 (*tclHasSockets) _ANSI_ARGS_((Tcl_Interp * interp)); /* 132 */
+ int (*tclpHasSockets) _ANSI_ARGS_((Tcl_Interp * interp)); /* 132 */
struct tm * (*tclpGetDate) _ANSI_ARGS_((TclpTime_t time, int useGMT)); /* 133 */
- size_t (*tclStrftime) _ANSI_ARGS_((char * s, size_t maxsize, const char * format, const struct tm * t)); /* 134 */
+ 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 */
} TclIntStubs;
extern TclIntStubs *tclIntStubsPtr;
@@ -601,548 +601,530 @@ extern TclIntStubs *tclIntStubsPtr;
*/
#ifndef TclAccess
-#define TclAccess(path, mode) \
- (tclIntStubsPtr->tclAccess)(path, mode) /* 0 */
+#define TclAccess \
+ (tclIntStubsPtr->tclAccess) /* 0 */
#endif
#ifndef TclAccessDeleteProc
-#define TclAccessDeleteProc(proc) \
- (tclIntStubsPtr->tclAccessDeleteProc)(proc) /* 1 */
+#define TclAccessDeleteProc \
+ (tclIntStubsPtr->tclAccessDeleteProc) /* 1 */
#endif
#ifndef TclAccessInsertProc
-#define TclAccessInsertProc(proc) \
- (tclIntStubsPtr->tclAccessInsertProc)(proc) /* 2 */
+#define TclAccessInsertProc \
+ (tclIntStubsPtr->tclAccessInsertProc) /* 2 */
#endif
#ifndef TclAllocateFreeObjects
-#define TclAllocateFreeObjects() \
- (tclIntStubsPtr->tclAllocateFreeObjects)() /* 3 */
-#endif
-#ifndef TclChdir
-#define TclChdir(interp, dirName) \
- (tclIntStubsPtr->tclChdir)(interp, dirName) /* 4 */
+#define TclAllocateFreeObjects \
+ (tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
#endif
+/* Slot 4 is reserved */
#ifndef TclCleanupChildren
-#define TclCleanupChildren(interp, numPids, pidPtr, errorChan) \
- (tclIntStubsPtr->tclCleanupChildren)(interp, numPids, pidPtr, errorChan) /* 5 */
+#define TclCleanupChildren \
+ (tclIntStubsPtr->tclCleanupChildren) /* 5 */
#endif
#ifndef TclCleanupCommand
-#define TclCleanupCommand(cmdPtr) \
- (tclIntStubsPtr->tclCleanupCommand)(cmdPtr) /* 6 */
+#define TclCleanupCommand \
+ (tclIntStubsPtr->tclCleanupCommand) /* 6 */
#endif
#ifndef TclCopyAndCollapse
-#define TclCopyAndCollapse(count, src, dst) \
- (tclIntStubsPtr->tclCopyAndCollapse)(count, src, dst) /* 7 */
+#define TclCopyAndCollapse \
+ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
#endif
#ifndef TclCopyChannel
-#define TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr) \
- (tclIntStubsPtr->tclCopyChannel)(interp, inChan, outChan, toRead, cmdPtr) /* 8 */
+#define TclCopyChannel \
+ (tclIntStubsPtr->tclCopyChannel) /* 8 */
#endif
#ifndef TclCreatePipeline
-#define TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr, outPipePtr, errFilePtr) \
- (tclIntStubsPtr->tclCreatePipeline)(interp, argc, argv, pidArrayPtr, inPipePtr, outPipePtr, errFilePtr) /* 9 */
+#define TclCreatePipeline \
+ (tclIntStubsPtr->tclCreatePipeline) /* 9 */
#endif
#ifndef TclCreateProc
-#define TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr) \
- (tclIntStubsPtr->tclCreateProc)(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr) /* 10 */
+#define TclCreateProc \
+ (tclIntStubsPtr->tclCreateProc) /* 10 */
#endif
#ifndef TclDeleteCompiledLocalVars
-#define TclDeleteCompiledLocalVars(iPtr, framePtr) \
- (tclIntStubsPtr->tclDeleteCompiledLocalVars)(iPtr, framePtr) /* 11 */
+#define TclDeleteCompiledLocalVars \
+ (tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
#endif
#ifndef TclDeleteVars
-#define TclDeleteVars(iPtr, tablePtr) \
- (tclIntStubsPtr->tclDeleteVars)(iPtr, tablePtr) /* 12 */
+#define TclDeleteVars \
+ (tclIntStubsPtr->tclDeleteVars) /* 12 */
#endif
#ifndef TclDoGlob
-#define TclDoGlob(interp, separators, headPtr, tail) \
- (tclIntStubsPtr->tclDoGlob)(interp, separators, headPtr, tail) /* 13 */
+#define TclDoGlob \
+ (tclIntStubsPtr->tclDoGlob) /* 13 */
#endif
#ifndef TclDumpMemoryInfo
-#define TclDumpMemoryInfo(outFile) \
- (tclIntStubsPtr->tclDumpMemoryInfo)(outFile) /* 14 */
-#endif
-#ifndef TclExpandParseValue
-#define TclExpandParseValue(pvPtr, needed) \
- (tclIntStubsPtr->tclExpandParseValue)(pvPtr, needed) /* 15 */
+#define TclDumpMemoryInfo \
+ (tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
#endif
+/* Slot 15 is reserved */
#ifndef TclExprFloatError
-#define TclExprFloatError(interp, value) \
- (tclIntStubsPtr->tclExprFloatError)(interp, value) /* 16 */
+#define TclExprFloatError \
+ (tclIntStubsPtr->tclExprFloatError) /* 16 */
#endif
#ifndef TclFileAttrsCmd
-#define TclFileAttrsCmd(interp, objc, objv) \
- (tclIntStubsPtr->tclFileAttrsCmd)(interp, objc, objv) /* 17 */
+#define TclFileAttrsCmd \
+ (tclIntStubsPtr->tclFileAttrsCmd) /* 17 */
#endif
#ifndef TclFileCopyCmd
-#define TclFileCopyCmd(interp, argc, argv) \
- (tclIntStubsPtr->tclFileCopyCmd)(interp, argc, argv) /* 18 */
+#define TclFileCopyCmd \
+ (tclIntStubsPtr->tclFileCopyCmd) /* 18 */
#endif
#ifndef TclFileDeleteCmd
-#define TclFileDeleteCmd(interp, argc, argv) \
- (tclIntStubsPtr->tclFileDeleteCmd)(interp, argc, argv) /* 19 */
+#define TclFileDeleteCmd \
+ (tclIntStubsPtr->tclFileDeleteCmd) /* 19 */
#endif
#ifndef TclFileMakeDirsCmd
-#define TclFileMakeDirsCmd(interp, argc, argv) \
- (tclIntStubsPtr->tclFileMakeDirsCmd)(interp, argc, argv) /* 20 */
+#define TclFileMakeDirsCmd \
+ (tclIntStubsPtr->tclFileMakeDirsCmd) /* 20 */
#endif
#ifndef TclFileRenameCmd
-#define TclFileRenameCmd(interp, argc, argv) \
- (tclIntStubsPtr->tclFileRenameCmd)(interp, argc, argv) /* 21 */
+#define TclFileRenameCmd \
+ (tclIntStubsPtr->tclFileRenameCmd) /* 21 */
#endif
#ifndef TclFindElement
-#define TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr, bracePtr) \
- (tclIntStubsPtr->tclFindElement)(interp, list, listLength, elementPtr, nextPtr, sizePtr, bracePtr) /* 22 */
+#define TclFindElement \
+ (tclIntStubsPtr->tclFindElement) /* 22 */
#endif
#ifndef TclFindProc
-#define TclFindProc(iPtr, procName) \
- (tclIntStubsPtr->tclFindProc)(iPtr, procName) /* 23 */
+#define TclFindProc \
+ (tclIntStubsPtr->tclFindProc) /* 23 */
#endif
#ifndef TclFormatInt
-#define TclFormatInt(buffer, n) \
- (tclIntStubsPtr->tclFormatInt)(buffer, n) /* 24 */
+#define TclFormatInt \
+ (tclIntStubsPtr->tclFormatInt) /* 24 */
#endif
#ifndef TclFreePackageInfo
-#define TclFreePackageInfo(iPtr) \
- (tclIntStubsPtr->tclFreePackageInfo)(iPtr) /* 25 */
-#endif
-#ifndef TclGetCwd
-#define TclGetCwd(interp) \
- (tclIntStubsPtr->tclGetCwd)(interp) /* 26 */
+#define TclFreePackageInfo \
+ (tclIntStubsPtr->tclFreePackageInfo) /* 25 */
#endif
+/* Slot 26 is reserved */
#ifndef TclGetDate
-#define TclGetDate(p, now, zone, timePtr) \
- (tclIntStubsPtr->tclGetDate)(p, now, zone, timePtr) /* 27 */
+#define TclGetDate \
+ (tclIntStubsPtr->tclGetDate) /* 27 */
#endif
-#ifndef TclGetDefaultStdChannel
-#define TclGetDefaultStdChannel(type) \
- (tclIntStubsPtr->tclGetDefaultStdChannel)(type) /* 28 */
+#ifndef TclpGetDefaultStdChannel
+#define TclpGetDefaultStdChannel \
+ (tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
#endif
#ifndef TclGetElementOfIndexedArray
-#define TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg) \
- (tclIntStubsPtr->tclGetElementOfIndexedArray)(interp, localIndex, elemPtr, leaveErrorMsg) /* 29 */
-#endif
-#ifndef TclGetEnv
-#define TclGetEnv(name) \
- (tclIntStubsPtr->tclGetEnv)(name) /* 30 */
+#define TclGetElementOfIndexedArray \
+ (tclIntStubsPtr->tclGetElementOfIndexedArray) /* 29 */
#endif
+/* Slot 30 is reserved */
#ifndef TclGetExtension
-#define TclGetExtension(name) \
- (tclIntStubsPtr->tclGetExtension)(name) /* 31 */
+#define TclGetExtension \
+ (tclIntStubsPtr->tclGetExtension) /* 31 */
#endif
#ifndef TclGetFrame
-#define TclGetFrame(interp, string, framePtrPtr) \
- (tclIntStubsPtr->tclGetFrame)(interp, string, framePtrPtr) /* 32 */
+#define TclGetFrame \
+ (tclIntStubsPtr->tclGetFrame) /* 32 */
#endif
#ifndef TclGetInterpProc
-#define TclGetInterpProc() \
- (tclIntStubsPtr->tclGetInterpProc)() /* 33 */
+#define TclGetInterpProc \
+ (tclIntStubsPtr->tclGetInterpProc) /* 33 */
#endif
#ifndef TclGetIntForIndex
-#define TclGetIntForIndex(interp, objPtr, endValue, indexPtr) \
- (tclIntStubsPtr->tclGetIntForIndex)(interp, objPtr, endValue, indexPtr) /* 34 */
+#define TclGetIntForIndex \
+ (tclIntStubsPtr->tclGetIntForIndex) /* 34 */
#endif
#ifndef TclGetIndexedScalar
-#define TclGetIndexedScalar(interp, localIndex, leaveErrorMsg) \
- (tclIntStubsPtr->tclGetIndexedScalar)(interp, localIndex, leaveErrorMsg) /* 35 */
+#define TclGetIndexedScalar \
+ (tclIntStubsPtr->tclGetIndexedScalar) /* 35 */
#endif
#ifndef TclGetLong
-#define TclGetLong(interp, string, longPtr) \
- (tclIntStubsPtr->tclGetLong)(interp, string, longPtr) /* 36 */
+#define TclGetLong \
+ (tclIntStubsPtr->tclGetLong) /* 36 */
#endif
#ifndef TclGetLoadedPackages
-#define TclGetLoadedPackages(interp, targetName) \
- (tclIntStubsPtr->tclGetLoadedPackages)(interp, targetName) /* 37 */
+#define TclGetLoadedPackages \
+ (tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#endif
#ifndef TclGetNamespaceForQualName
-#define TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr) \
- (tclIntStubsPtr->tclGetNamespaceForQualName)(interp, qualName, cxtNsPtr, flags, nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr) /* 38 */
+#define TclGetNamespaceForQualName \
+ (tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#endif
#ifndef TclGetObjInterpProc
-#define TclGetObjInterpProc() \
- (tclIntStubsPtr->tclGetObjInterpProc)() /* 39 */
+#define TclGetObjInterpProc \
+ (tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
#endif
#ifndef TclGetOpenMode
-#define TclGetOpenMode(interp, string, seekFlagPtr) \
- (tclIntStubsPtr->tclGetOpenMode)(interp, string, seekFlagPtr) /* 40 */
+#define TclGetOpenMode \
+ (tclIntStubsPtr->tclGetOpenMode) /* 40 */
#endif
#ifndef TclGetOriginalCommand
-#define TclGetOriginalCommand(command) \
- (tclIntStubsPtr->tclGetOriginalCommand)(command) /* 41 */
+#define TclGetOriginalCommand \
+ (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
#endif
-#ifndef TclGetUserHome
-#define TclGetUserHome(name, bufferPtr) \
- (tclIntStubsPtr->tclGetUserHome)(name, bufferPtr) /* 42 */
+#ifndef TclpGetUserHome
+#define TclpGetUserHome \
+ (tclIntStubsPtr->tclpGetUserHome) /* 42 */
#endif
#ifndef TclGlobalInvoke
-#define TclGlobalInvoke(interp, argc, argv, flags) \
- (tclIntStubsPtr->tclGlobalInvoke)(interp, argc, argv, flags) /* 43 */
+#define TclGlobalInvoke \
+ (tclIntStubsPtr->tclGlobalInvoke) /* 43 */
#endif
#ifndef TclGuessPackageName
-#define TclGuessPackageName(fileName, bufPtr) \
- (tclIntStubsPtr->tclGuessPackageName)(fileName, bufPtr) /* 44 */
+#define TclGuessPackageName \
+ (tclIntStubsPtr->tclGuessPackageName) /* 44 */
#endif
#ifndef TclHideUnsafeCommands
-#define TclHideUnsafeCommands(interp) \
- (tclIntStubsPtr->tclHideUnsafeCommands)(interp) /* 45 */
+#define TclHideUnsafeCommands \
+ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#endif
#ifndef TclInExit
-#define TclInExit() \
- (tclIntStubsPtr->tclInExit)() /* 46 */
+#define TclInExit \
+ (tclIntStubsPtr->tclInExit) /* 46 */
#endif
#ifndef TclIncrElementOfIndexedArray
-#define TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount) \
- (tclIntStubsPtr->tclIncrElementOfIndexedArray)(interp, localIndex, elemPtr, incrAmount) /* 47 */
+#define TclIncrElementOfIndexedArray \
+ (tclIntStubsPtr->tclIncrElementOfIndexedArray) /* 47 */
#endif
#ifndef TclIncrIndexedScalar
-#define TclIncrIndexedScalar(interp, localIndex, incrAmount) \
- (tclIntStubsPtr->tclIncrIndexedScalar)(interp, localIndex, incrAmount) /* 48 */
+#define TclIncrIndexedScalar \
+ (tclIntStubsPtr->tclIncrIndexedScalar) /* 48 */
#endif
#ifndef TclIncrVar2
-#define TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed) \
- (tclIntStubsPtr->tclIncrVar2)(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed) /* 49 */
+#define TclIncrVar2 \
+ (tclIntStubsPtr->tclIncrVar2) /* 49 */
#endif
#ifndef TclInitCompiledLocals
-#define TclInitCompiledLocals(interp, framePtr, nsPtr) \
- (tclIntStubsPtr->tclInitCompiledLocals)(interp, framePtr, nsPtr) /* 50 */
+#define TclInitCompiledLocals \
+ (tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
#endif
#ifndef TclInterpInit
-#define TclInterpInit(interp) \
- (tclIntStubsPtr->tclInterpInit)(interp) /* 51 */
+#define TclInterpInit \
+ (tclIntStubsPtr->tclInterpInit) /* 51 */
#endif
#ifndef TclInvoke
-#define TclInvoke(interp, argc, argv, flags) \
- (tclIntStubsPtr->tclInvoke)(interp, argc, argv, flags) /* 52 */
+#define TclInvoke \
+ (tclIntStubsPtr->tclInvoke) /* 52 */
#endif
#ifndef TclInvokeObjectCommand
-#define TclInvokeObjectCommand(clientData, interp, argc, argv) \
- (tclIntStubsPtr->tclInvokeObjectCommand)(clientData, interp, argc, argv) /* 53 */
+#define TclInvokeObjectCommand \
+ (tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
#endif
#ifndef TclInvokeStringCommand
-#define TclInvokeStringCommand(clientData, interp, objc, objv) \
- (tclIntStubsPtr->tclInvokeStringCommand)(clientData, interp, objc, objv) /* 54 */
+#define TclInvokeStringCommand \
+ (tclIntStubsPtr->tclInvokeStringCommand) /* 54 */
#endif
#ifndef TclIsProc
-#define TclIsProc(cmdPtr) \
- (tclIntStubsPtr->tclIsProc)(cmdPtr) /* 55 */
-#endif
-#ifndef TclLoadFile
-#define TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr) \
- (tclIntStubsPtr->tclLoadFile)(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr) /* 56 */
-#endif
-#ifndef TclLooksLikeInt
-#define TclLooksLikeInt(p) \
- (tclIntStubsPtr->tclLooksLikeInt)(p) /* 57 */
+#define TclIsProc \
+ (tclIntStubsPtr->tclIsProc) /* 55 */
#endif
+/* Slot 56 is reserved */
+/* Slot 57 is reserved */
#ifndef TclLookupVar
-#define TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, arrayPtrPtr) \
- (tclIntStubsPtr->tclLookupVar)(interp, part1, part2, flags, msg, createPart1, createPart2, arrayPtrPtr) /* 58 */
+#define TclLookupVar \
+ (tclIntStubsPtr->tclLookupVar) /* 58 */
#endif
-#ifndef TclMatchFiles
-#define TclMatchFiles(interp, separators, dirPtr, pattern, tail) \
- (tclIntStubsPtr->tclMatchFiles)(interp, separators, dirPtr, pattern, tail) /* 59 */
+#ifndef TclpMatchFiles
+#define TclpMatchFiles \
+ (tclIntStubsPtr->tclpMatchFiles) /* 59 */
#endif
#ifndef TclNeedSpace
-#define TclNeedSpace(start, end) \
- (tclIntStubsPtr->tclNeedSpace)(start, end) /* 60 */
+#define TclNeedSpace \
+ (tclIntStubsPtr->tclNeedSpace) /* 60 */
#endif
#ifndef TclNewProcBodyObj
-#define TclNewProcBodyObj(procPtr) \
- (tclIntStubsPtr->tclNewProcBodyObj)(procPtr) /* 61 */
+#define TclNewProcBodyObj \
+ (tclIntStubsPtr->tclNewProcBodyObj) /* 61 */
#endif
#ifndef TclObjCommandComplete
-#define TclObjCommandComplete(cmdPtr) \
- (tclIntStubsPtr->tclObjCommandComplete)(cmdPtr) /* 62 */
+#define TclObjCommandComplete \
+ (tclIntStubsPtr->tclObjCommandComplete) /* 62 */
#endif
#ifndef TclObjInterpProc
-#define TclObjInterpProc(clientData, interp, objc, objv) \
- (tclIntStubsPtr->tclObjInterpProc)(clientData, interp, objc, objv) /* 63 */
+#define TclObjInterpProc \
+ (tclIntStubsPtr->tclObjInterpProc) /* 63 */
#endif
#ifndef TclObjInvoke
-#define TclObjInvoke(interp, objc, objv, flags) \
- (tclIntStubsPtr->tclObjInvoke)(interp, objc, objv, flags) /* 64 */
+#define TclObjInvoke \
+ (tclIntStubsPtr->tclObjInvoke) /* 64 */
#endif
#ifndef TclObjInvokeGlobal
-#define TclObjInvokeGlobal(interp, objc, objv, flags) \
- (tclIntStubsPtr->tclObjInvokeGlobal)(interp, objc, objv, flags) /* 65 */
+#define TclObjInvokeGlobal \
+ (tclIntStubsPtr->tclObjInvokeGlobal) /* 65 */
#endif
#ifndef TclOpenFileChannelDeleteProc
-#define TclOpenFileChannelDeleteProc(proc) \
- (tclIntStubsPtr->tclOpenFileChannelDeleteProc)(proc) /* 66 */
+#define TclOpenFileChannelDeleteProc \
+ (tclIntStubsPtr->tclOpenFileChannelDeleteProc) /* 66 */
#endif
#ifndef TclOpenFileChannelInsertProc
-#define TclOpenFileChannelInsertProc(proc) \
- (tclIntStubsPtr->tclOpenFileChannelInsertProc)(proc) /* 67 */
+#define TclOpenFileChannelInsertProc \
+ (tclIntStubsPtr->tclOpenFileChannelInsertProc) /* 67 */
#endif
#ifndef TclpAccess
-#define TclpAccess(path, mode) \
- (tclIntStubsPtr->tclpAccess)(path, mode) /* 68 */
+#define TclpAccess \
+ (tclIntStubsPtr->tclpAccess) /* 68 */
#endif
#ifndef TclpAlloc
-#define TclpAlloc(size) \
- (tclIntStubsPtr->tclpAlloc)(size) /* 69 */
+#define TclpAlloc \
+ (tclIntStubsPtr->tclpAlloc) /* 69 */
#endif
#ifndef TclpCopyFile
-#define TclpCopyFile(source, dest) \
- (tclIntStubsPtr->tclpCopyFile)(source, dest) /* 70 */
+#define TclpCopyFile \
+ (tclIntStubsPtr->tclpCopyFile) /* 70 */
#endif
#ifndef TclpCopyDirectory
-#define TclpCopyDirectory(source, dest, errorPtr) \
- (tclIntStubsPtr->tclpCopyDirectory)(source, dest, errorPtr) /* 71 */
+#define TclpCopyDirectory \
+ (tclIntStubsPtr->tclpCopyDirectory) /* 71 */
#endif
#ifndef TclpCreateDirectory
-#define TclpCreateDirectory(path) \
- (tclIntStubsPtr->tclpCreateDirectory)(path) /* 72 */
+#define TclpCreateDirectory \
+ (tclIntStubsPtr->tclpCreateDirectory) /* 72 */
#endif
#ifndef TclpDeleteFile
-#define TclpDeleteFile(path) \
- (tclIntStubsPtr->tclpDeleteFile)(path) /* 73 */
+#define TclpDeleteFile \
+ (tclIntStubsPtr->tclpDeleteFile) /* 73 */
#endif
#ifndef TclpFree
-#define TclpFree(ptr) \
- (tclIntStubsPtr->tclpFree)(ptr) /* 74 */
+#define TclpFree \
+ (tclIntStubsPtr->tclpFree) /* 74 */
#endif
#ifndef TclpGetClicks
-#define TclpGetClicks() \
- (tclIntStubsPtr->tclpGetClicks)() /* 75 */
+#define TclpGetClicks \
+ (tclIntStubsPtr->tclpGetClicks) /* 75 */
#endif
#ifndef TclpGetSeconds
-#define TclpGetSeconds() \
- (tclIntStubsPtr->tclpGetSeconds)() /* 76 */
+#define TclpGetSeconds \
+ (tclIntStubsPtr->tclpGetSeconds) /* 76 */
#endif
#ifndef TclpGetTime
-#define TclpGetTime(time) \
- (tclIntStubsPtr->tclpGetTime)(time) /* 77 */
+#define TclpGetTime \
+ (tclIntStubsPtr->tclpGetTime) /* 77 */
#endif
#ifndef TclpGetTimeZone
-#define TclpGetTimeZone(time) \
- (tclIntStubsPtr->tclpGetTimeZone)(time) /* 78 */
+#define TclpGetTimeZone \
+ (tclIntStubsPtr->tclpGetTimeZone) /* 78 */
#endif
#ifndef TclpListVolumes
-#define TclpListVolumes(interp) \
- (tclIntStubsPtr->tclpListVolumes)(interp) /* 79 */
+#define TclpListVolumes \
+ (tclIntStubsPtr->tclpListVolumes) /* 79 */
#endif
#ifndef TclpOpenFileChannel
-#define TclpOpenFileChannel(interp, fileName, modeString, permissions) \
- (tclIntStubsPtr->tclpOpenFileChannel)(interp, fileName, modeString, permissions) /* 80 */
+#define TclpOpenFileChannel \
+ (tclIntStubsPtr->tclpOpenFileChannel) /* 80 */
#endif
#ifndef TclpRealloc
-#define TclpRealloc(ptr, size) \
- (tclIntStubsPtr->tclpRealloc)(ptr, size) /* 81 */
+#define TclpRealloc \
+ (tclIntStubsPtr->tclpRealloc) /* 81 */
#endif
#ifndef TclpRemoveDirectory
-#define TclpRemoveDirectory(path, recursive, errorPtr) \
- (tclIntStubsPtr->tclpRemoveDirectory)(path, recursive, errorPtr) /* 82 */
+#define TclpRemoveDirectory \
+ (tclIntStubsPtr->tclpRemoveDirectory) /* 82 */
#endif
#ifndef TclpRenameFile
-#define TclpRenameFile(source, dest) \
- (tclIntStubsPtr->tclpRenameFile)(source, dest) /* 83 */
-#endif
-#ifndef TclParseBraces
-#define TclParseBraces(interp, string, termPtr, pvPtr) \
- (tclIntStubsPtr->tclParseBraces)(interp, string, termPtr, pvPtr) /* 84 */
-#endif
-#ifndef TclParseNestedCmd
-#define TclParseNestedCmd(interp, string, flags, termPtr, pvPtr) \
- (tclIntStubsPtr->tclParseNestedCmd)(interp, string, flags, termPtr, pvPtr) /* 85 */
-#endif
-#ifndef TclParseQuotes
-#define TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr) \
- (tclIntStubsPtr->tclParseQuotes)(interp, string, termChar, flags, termPtr, pvPtr) /* 86 */
-#endif
-#ifndef TclPlatformInit
-#define TclPlatformInit(interp) \
- (tclIntStubsPtr->tclPlatformInit)(interp) /* 87 */
+#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(clientData, interp, name1, name2, flags) \
- (tclIntStubsPtr->tclPrecTraceProc)(clientData, interp, name1, name2, flags) /* 88 */
+#define TclPrecTraceProc \
+ (tclIntStubsPtr->tclPrecTraceProc) /* 88 */
#endif
#ifndef TclPreventAliasLoop
-#define TclPreventAliasLoop(interp, cmdInterp, cmd) \
- (tclIntStubsPtr->tclPreventAliasLoop)(interp, cmdInterp, cmd) /* 89 */
-#endif
-#ifndef TclPrintByteCodeObj
-#define TclPrintByteCodeObj(interp, objPtr) \
- (tclIntStubsPtr->tclPrintByteCodeObj)(interp, objPtr) /* 90 */
+#define TclPreventAliasLoop \
+ (tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
#endif
+/* Slot 90 is reserved */
#ifndef TclProcCleanupProc
-#define TclProcCleanupProc(procPtr) \
- (tclIntStubsPtr->tclProcCleanupProc)(procPtr) /* 91 */
+#define TclProcCleanupProc \
+ (tclIntStubsPtr->tclProcCleanupProc) /* 91 */
#endif
#ifndef TclProcCompileProc
-#define TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName) \
- (tclIntStubsPtr->tclProcCompileProc)(interp, procPtr, bodyPtr, nsPtr, description, procName) /* 92 */
+#define TclProcCompileProc \
+ (tclIntStubsPtr->tclProcCompileProc) /* 92 */
#endif
#ifndef TclProcDeleteProc
-#define TclProcDeleteProc(clientData) \
- (tclIntStubsPtr->tclProcDeleteProc)(clientData) /* 93 */
+#define TclProcDeleteProc \
+ (tclIntStubsPtr->tclProcDeleteProc) /* 93 */
#endif
#ifndef TclProcInterpProc
-#define TclProcInterpProc(clientData, interp, argc, argv) \
- (tclIntStubsPtr->tclProcInterpProc)(clientData, interp, argc, argv) /* 94 */
+#define TclProcInterpProc \
+ (tclIntStubsPtr->tclProcInterpProc) /* 94 */
#endif
#ifndef TclpStat
-#define TclpStat(path, buf) \
- (tclIntStubsPtr->tclpStat)(path, buf) /* 95 */
+#define TclpStat \
+ (tclIntStubsPtr->tclpStat) /* 95 */
#endif
#ifndef TclRenameCommand
-#define TclRenameCommand(interp, oldName, newName) \
- (tclIntStubsPtr->tclRenameCommand)(interp, oldName, newName) /* 96 */
+#define TclRenameCommand \
+ (tclIntStubsPtr->tclRenameCommand) /* 96 */
#endif
#ifndef TclResetShadowedCmdRefs
-#define TclResetShadowedCmdRefs(interp, newCmdPtr) \
- (tclIntStubsPtr->tclResetShadowedCmdRefs)(interp, newCmdPtr) /* 97 */
+#define TclResetShadowedCmdRefs \
+ (tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */
#endif
#ifndef TclServiceIdle
-#define TclServiceIdle() \
- (tclIntStubsPtr->tclServiceIdle)() /* 98 */
+#define TclServiceIdle \
+ (tclIntStubsPtr->tclServiceIdle) /* 98 */
#endif
#ifndef TclSetElementOfIndexedArray
-#define TclSetElementOfIndexedArray(interp, localIndex, elemPtr, objPtr, leaveErrorMsg) \
- (tclIntStubsPtr->tclSetElementOfIndexedArray)(interp, localIndex, elemPtr, objPtr, leaveErrorMsg) /* 99 */
+#define TclSetElementOfIndexedArray \
+ (tclIntStubsPtr->tclSetElementOfIndexedArray) /* 99 */
#endif
#ifndef TclSetIndexedScalar
-#define TclSetIndexedScalar(interp, localIndex, objPtr, leaveErrorMsg) \
- (tclIntStubsPtr->tclSetIndexedScalar)(interp, localIndex, objPtr, leaveErrorMsg) /* 100 */
-#endif
-#ifndef TclSetPreInitScript
-#define TclSetPreInitScript(string) \
- (tclIntStubsPtr->tclSetPreInitScript)(string) /* 101 */
+#define TclSetIndexedScalar \
+ (tclIntStubsPtr->tclSetIndexedScalar) /* 100 */
#endif
+/* Slot 101 is reserved */
#ifndef TclSetupEnv
-#define TclSetupEnv(interp) \
- (tclIntStubsPtr->tclSetupEnv)(interp) /* 102 */
+#define TclSetupEnv \
+ (tclIntStubsPtr->tclSetupEnv) /* 102 */
#endif
#ifndef TclSockGetPort
-#define TclSockGetPort(interp, string, proto, portPtr) \
- (tclIntStubsPtr->tclSockGetPort)(interp, string, proto, portPtr) /* 103 */
+#define TclSockGetPort \
+ (tclIntStubsPtr->tclSockGetPort) /* 103 */
#endif
#ifndef TclSockMinimumBuffers
-#define TclSockMinimumBuffers(sock, size) \
- (tclIntStubsPtr->tclSockMinimumBuffers)(sock, size) /* 104 */
+#define TclSockMinimumBuffers \
+ (tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
#endif
#ifndef TclStat
-#define TclStat(path, buf) \
- (tclIntStubsPtr->tclStat)(path, buf) /* 105 */
+#define TclStat \
+ (tclIntStubsPtr->tclStat) /* 105 */
#endif
#ifndef TclStatDeleteProc
-#define TclStatDeleteProc(proc) \
- (tclIntStubsPtr->tclStatDeleteProc)(proc) /* 106 */
+#define TclStatDeleteProc \
+ (tclIntStubsPtr->tclStatDeleteProc) /* 106 */
#endif
#ifndef TclStatInsertProc
-#define TclStatInsertProc(proc) \
- (tclIntStubsPtr->tclStatInsertProc)(proc) /* 107 */
+#define TclStatInsertProc \
+ (tclIntStubsPtr->tclStatInsertProc) /* 107 */
#endif
#ifndef TclTeardownNamespace
-#define TclTeardownNamespace(nsPtr) \
- (tclIntStubsPtr->tclTeardownNamespace)(nsPtr) /* 108 */
+#define TclTeardownNamespace \
+ (tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#endif
#ifndef TclUpdateReturnInfo
-#define TclUpdateReturnInfo(iPtr) \
- (tclIntStubsPtr->tclUpdateReturnInfo)(iPtr) /* 109 */
-#endif
-#ifndef TclWordEnd
-#define TclWordEnd(start, lastChar, nested, semiPtr) \
- (tclIntStubsPtr->tclWordEnd)(start, lastChar, nested, semiPtr) /* 110 */
+#define TclUpdateReturnInfo \
+ (tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#endif
+/* Slot 110 is reserved */
#ifndef Tcl_AddInterpResolvers
-#define Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc) \
- (tclIntStubsPtr->tcl_AddInterpResolvers)(interp, name, cmdProc, varProc, compiledVarProc) /* 111 */
+#define Tcl_AddInterpResolvers \
+ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#endif
#ifndef Tcl_AppendExportList
-#define Tcl_AppendExportList(interp, nsPtr, objPtr) \
- (tclIntStubsPtr->tcl_AppendExportList)(interp, nsPtr, objPtr) /* 112 */
+#define Tcl_AppendExportList \
+ (tclIntStubsPtr->tcl_AppendExportList) /* 112 */
#endif
#ifndef Tcl_CreateNamespace
-#define Tcl_CreateNamespace(interp, name, clientData, deleteProc) \
- (tclIntStubsPtr->tcl_CreateNamespace)(interp, name, clientData, deleteProc) /* 113 */
+#define Tcl_CreateNamespace \
+ (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
#endif
#ifndef Tcl_DeleteNamespace
-#define Tcl_DeleteNamespace(nsPtr) \
- (tclIntStubsPtr->tcl_DeleteNamespace)(nsPtr) /* 114 */
+#define Tcl_DeleteNamespace \
+ (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
#endif
#ifndef Tcl_Export
-#define Tcl_Export(interp, nsPtr, pattern, resetListFirst) \
- (tclIntStubsPtr->tcl_Export)(interp, nsPtr, pattern, resetListFirst) /* 115 */
+#define Tcl_Export \
+ (tclIntStubsPtr->tcl_Export) /* 115 */
#endif
#ifndef Tcl_FindCommand
-#define Tcl_FindCommand(interp, name, contextNsPtr, flags) \
- (tclIntStubsPtr->tcl_FindCommand)(interp, name, contextNsPtr, flags) /* 116 */
+#define Tcl_FindCommand \
+ (tclIntStubsPtr->tcl_FindCommand) /* 116 */
#endif
#ifndef Tcl_FindNamespace
-#define Tcl_FindNamespace(interp, name, contextNsPtr, flags) \
- (tclIntStubsPtr->tcl_FindNamespace)(interp, name, contextNsPtr, flags) /* 117 */
+#define Tcl_FindNamespace \
+ (tclIntStubsPtr->tcl_FindNamespace) /* 117 */
#endif
#ifndef Tcl_GetInterpResolvers
-#define Tcl_GetInterpResolvers(interp, name, resInfo) \
- (tclIntStubsPtr->tcl_GetInterpResolvers)(interp, name, resInfo) /* 118 */
+#define Tcl_GetInterpResolvers \
+ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#endif
#ifndef Tcl_GetNamespaceResolvers
-#define Tcl_GetNamespaceResolvers(namespacePtr, resInfo) \
- (tclIntStubsPtr->tcl_GetNamespaceResolvers)(namespacePtr, resInfo) /* 119 */
+#define Tcl_GetNamespaceResolvers \
+ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#endif
#ifndef Tcl_FindNamespaceVar
-#define Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags) \
- (tclIntStubsPtr->tcl_FindNamespaceVar)(interp, name, contextNsPtr, flags) /* 120 */
+#define Tcl_FindNamespaceVar \
+ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
#endif
#ifndef Tcl_ForgetImport
-#define Tcl_ForgetImport(interp, nsPtr, pattern) \
- (tclIntStubsPtr->tcl_ForgetImport)(interp, nsPtr, pattern) /* 121 */
+#define Tcl_ForgetImport \
+ (tclIntStubsPtr->tcl_ForgetImport) /* 121 */
#endif
#ifndef Tcl_GetCommandFromObj
-#define Tcl_GetCommandFromObj(interp, objPtr) \
- (tclIntStubsPtr->tcl_GetCommandFromObj)(interp, objPtr) /* 122 */
+#define Tcl_GetCommandFromObj \
+ (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
#endif
#ifndef Tcl_GetCommandFullName
-#define Tcl_GetCommandFullName(interp, command, objPtr) \
- (tclIntStubsPtr->tcl_GetCommandFullName)(interp, command, objPtr) /* 123 */
+#define Tcl_GetCommandFullName \
+ (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
#endif
#ifndef Tcl_GetCurrentNamespace
-#define Tcl_GetCurrentNamespace(interp) \
- (tclIntStubsPtr->tcl_GetCurrentNamespace)(interp) /* 124 */
+#define Tcl_GetCurrentNamespace \
+ (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
#endif
#ifndef Tcl_GetGlobalNamespace
-#define Tcl_GetGlobalNamespace(interp) \
- (tclIntStubsPtr->tcl_GetGlobalNamespace)(interp) /* 125 */
+#define Tcl_GetGlobalNamespace \
+ (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
#endif
#ifndef Tcl_GetVariableFullName
-#define Tcl_GetVariableFullName(interp, variable, objPtr) \
- (tclIntStubsPtr->tcl_GetVariableFullName)(interp, variable, objPtr) /* 126 */
+#define Tcl_GetVariableFullName \
+ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#endif
#ifndef Tcl_Import
-#define Tcl_Import(interp, nsPtr, pattern, allowOverwrite) \
- (tclIntStubsPtr->tcl_Import)(interp, nsPtr, pattern, allowOverwrite) /* 127 */
+#define Tcl_Import \
+ (tclIntStubsPtr->tcl_Import) /* 127 */
#endif
#ifndef Tcl_PopCallFrame
-#define Tcl_PopCallFrame(interp) \
- (tclIntStubsPtr->tcl_PopCallFrame)(interp) /* 128 */
+#define Tcl_PopCallFrame \
+ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#endif
#ifndef Tcl_PushCallFrame
-#define Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame) \
- (tclIntStubsPtr->tcl_PushCallFrame)(interp, framePtr, nsPtr, isProcCallFrame) /* 129 */
+#define Tcl_PushCallFrame \
+ (tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#endif
#ifndef Tcl_RemoveInterpResolvers
-#define Tcl_RemoveInterpResolvers(interp, name) \
- (tclIntStubsPtr->tcl_RemoveInterpResolvers)(interp, name) /* 130 */
+#define Tcl_RemoveInterpResolvers \
+ (tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#endif
#ifndef Tcl_SetNamespaceResolvers
-#define Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc) \
- (tclIntStubsPtr->tcl_SetNamespaceResolvers)(namespacePtr, cmdProc, varProc, compiledVarProc) /* 131 */
+#define Tcl_SetNamespaceResolvers \
+ (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#endif
-#ifndef TclHasSockets
-#define TclHasSockets(interp) \
- (tclIntStubsPtr->tclHasSockets)(interp) /* 132 */
+#ifndef TclpHasSockets
+#define TclpHasSockets \
+ (tclIntStubsPtr->tclpHasSockets) /* 132 */
#endif
#ifndef TclpGetDate
-#define TclpGetDate(time, useGMT) \
- (tclIntStubsPtr->tclpGetDate)(time, useGMT) /* 133 */
+#define TclpGetDate \
+ (tclIntStubsPtr->tclpGetDate) /* 133 */
#endif
-#ifndef TclStrftime
-#define TclStrftime(s, maxsize, format, t) \
- (tclIntStubsPtr->tclStrftime)(s, maxsize, format, t) /* 134 */
+#ifndef TclpStrftime
+#define TclpStrftime \
+ (tclIntStubsPtr->tclpStrftime) /* 134 */
#endif
#ifndef TclpCheckStackSpace
-#define TclpCheckStackSpace() \
- (tclIntStubsPtr->tclpCheckStackSpace)() /* 135 */
+#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
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
@@ -1150,4 +1132,3 @@ extern TclIntStubs *tclIntStubsPtr;
/* !END!: Do not edit above this line. */
#endif /* _TCLINTDECLS */
-
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index bfb3cf7..628a03b 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -9,7 +9,7 @@
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.4 1999/03/11 00:19:23 stanton Exp $
+ * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.5 1999/04/16 00:46:48 stanton Exp $
*/
#ifndef _TCLINTPLATDECLS
@@ -46,17 +46,19 @@ EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
int argc, char ** argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid * pidPtr));
-/* 5 */
-EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((char * contents,
- Tcl_DString * namePtr));
+/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile TclpMakeFile _ANSI_ARGS_((Tcl_Channel channel,
int direction));
/* 7 */
-EXTERN TclFile TclpOpenFile _ANSI_ARGS_((char * fname, int mode));
+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 */
@@ -64,21 +66,20 @@ 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));
+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));
-/* 5 */
-EXTERN HINSTANCE TclWinLoadLibrary _ANSI_ARGS_((char * name));
+/* 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 optname, CONST char FAR * optval,
int optlen));
/* 8 */
EXTERN unsigned long TclpGetPid _ANSI_ARGS_((Tcl_Pid pid));
@@ -105,21 +106,26 @@ EXTERN int TclpCreateProcess _ANSI_ARGS_((Tcl_Interp * interp,
int argc, char ** argv, TclFile inputFile,
TclFile outputFile, TclFile errorFile,
Tcl_Pid * pidPtr));
-/* 16 */
-EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_((char * contents,
- Tcl_DString * namePtr));
-/* 17 */
-EXTERN char * TclpGetTZName _ANSI_ARGS_((void));
+/* 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_((char * fname, int mode));
+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));
#endif /* __WIN32__ */
#ifdef MAC_TCL
/* 0 */
@@ -130,7 +136,7 @@ EXTERN void TclpSysFree _ANSI_ARGS_((VOID * ptr));
EXTERN VOID * TclpSysRealloc _ANSI_ARGS_((VOID * cp,
unsigned int size));
/* 3 */
-EXTERN void TclPlatformExit _ANSI_ARGS_((int status));
+EXTERN void TclpExit _ANSI_ARGS_((int status));
/* 4 */
EXTERN int FSpGetDefaultDir _ANSI_ARGS_((FSSpecPtr theSpec));
/* 5 */
@@ -142,14 +148,14 @@ EXTERN OSErr FSpFindFolder _ANSI_ARGS_((short vRefNum,
/* 7 */
EXTERN void GetGlobalMouse _ANSI_ARGS_((Point * mouse));
/* 8 */
-EXTERN pascal OSErr FSpGetDirectoryID _ANSI_ARGS_((const FSSpec * spec,
+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));
+ CONST FSSpec * spec, SignedByte permission));
/* 10 */
EXTERN pascal void FSpCreateResFileCompat _ANSI_ARGS_((
- const FSSpec * spec, OSType creator,
+ CONST FSSpec * spec, OSType creator,
OSType fileType, ScriptCode scriptTag));
/* 11 */
EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length,
@@ -182,11 +188,9 @@ EXTERN short TclMacUnRegisterResourceFork _ANSI_ARGS_((
/* 22 */
EXTERN int TclMacCreateEnv _ANSI_ARGS_((void));
/* 23 */
-EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((const char * path,
- const char * mode));
-/* 24 */
-EXTERN int TclMacReadlink _ANSI_ARGS_((char * path, char * buf,
- int size));
+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 */
@@ -201,20 +205,21 @@ typedef struct TclIntPlatStubs {
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 */
- TclFile (*tclpCreateTempFile) _ANSI_ARGS_((char * contents, Tcl_DString * namePtr)); /* 5 */
+ void *reserved5;
TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */
- TclFile (*tclpOpenFile) _ANSI_ARGS_((char * fname, int mode)); /* 7 */
+ 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 */
+ 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 */
- HINSTANCE (*tclWinLoadLibrary) _ANSI_ARGS_((char * name)); /* 5 */
+ 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 */
+ 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 */
int (*tclWinSynchSpawn) _ANSI_ARGS_((void * args, int type, void ** trans, Tcl_Pid * pidPtr)); /* 10 */
@@ -223,25 +228,28 @@ typedef struct TclIntPlatStubs {
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 */
- TclFile (*tclpCreateTempFile) _ANSI_ARGS_((char * contents, Tcl_DString * namePtr)); /* 16 */
- char * (*tclpGetTZName) _ANSI_ARGS_((void)); /* 17 */
+ void *reserved16;
+ void *reserved17;
TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 18 */
- TclFile (*tclpOpenFile) _ANSI_ARGS_((char * fname, int mode)); /* 19 */
+ 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 */
#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 (*tclPlatformExit) _ANSI_ARGS_((int status)); /* 3 */
+ 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 */
+ 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 */
@@ -254,8 +262,8 @@ typedef struct TclIntPlatStubs {
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 */
- int (*tclMacReadlink) _ANSI_ARGS_((char * path, char * buf, int size)); /* 24 */
+ 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;
@@ -270,236 +278,237 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
#ifndef TclGetAndDetachPids
-#define TclGetAndDetachPids(interp, chan) \
- (tclIntPlatStubsPtr->tclGetAndDetachPids)(interp, chan) /* 0 */
+#define TclGetAndDetachPids \
+ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#endif
#ifndef TclpCloseFile
-#define TclpCloseFile(file) \
- (tclIntPlatStubsPtr->tclpCloseFile)(file) /* 1 */
+#define TclpCloseFile \
+ (tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#endif
#ifndef TclpCreateCommandChannel
-#define TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr) \
- (tclIntPlatStubsPtr->tclpCreateCommandChannel)(readFile, writeFile, errorFile, numPids, pidPtr) /* 2 */
+#define TclpCreateCommandChannel \
+ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#endif
#ifndef TclpCreatePipe
-#define TclpCreatePipe(readPipe, writePipe) \
- (tclIntPlatStubsPtr->tclpCreatePipe)(readPipe, writePipe) /* 3 */
+#define TclpCreatePipe \
+ (tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#endif
#ifndef TclpCreateProcess
-#define TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr) \
- (tclIntPlatStubsPtr->tclpCreateProcess)(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr) /* 4 */
-#endif
-#ifndef TclpCreateTempFile
-#define TclpCreateTempFile(contents, namePtr) \
- (tclIntPlatStubsPtr->tclpCreateTempFile)(contents, namePtr) /* 5 */
+#define TclpCreateProcess \
+ (tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#endif
+/* Slot 5 is reserved */
#ifndef TclpMakeFile
-#define TclpMakeFile(channel, direction) \
- (tclIntPlatStubsPtr->tclpMakeFile)(channel, direction) /* 6 */
+#define TclpMakeFile \
+ (tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#endif
#ifndef TclpOpenFile
-#define TclpOpenFile(fname, mode) \
- (tclIntPlatStubsPtr->tclpOpenFile)(fname, mode) /* 7 */
+#define TclpOpenFile \
+ (tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#endif
#ifndef TclUnixWaitForFile
-#define TclUnixWaitForFile(fd, mask, timeout) \
- (tclIntPlatStubsPtr->tclUnixWaitForFile)(fd, mask, timeout) /* 8 */
+#define TclUnixWaitForFile \
+ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
+#endif
+#ifndef TclpCreateTempFile
+#define TclpCreateTempFile \
+ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#endif
#endif /* UNIX */
#ifdef __WIN32__
#ifndef TclWinConvertError
-#define TclWinConvertError(errCode) \
- (tclIntPlatStubsPtr->tclWinConvertError)(errCode) /* 0 */
+#define TclWinConvertError \
+ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#endif
#ifndef TclWinConvertWSAError
-#define TclWinConvertWSAError(errCode) \
- (tclIntPlatStubsPtr->tclWinConvertWSAError)(errCode) /* 1 */
+#define TclWinConvertWSAError \
+ (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#endif
#ifndef TclWinGetServByName
-#define TclWinGetServByName(nm, proto) \
- (tclIntPlatStubsPtr->tclWinGetServByName)(nm, proto) /* 2 */
+#define TclWinGetServByName \
+ (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
#endif
#ifndef TclWinGetSockOpt
-#define TclWinGetSockOpt(s, level, optname, optval, optlen) \
- (tclIntPlatStubsPtr->tclWinGetSockOpt)(s, level, optname, optval, optlen) /* 3 */
+#define TclWinGetSockOpt \
+ (tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
#endif
#ifndef TclWinGetTclInstance
-#define TclWinGetTclInstance() \
- (tclIntPlatStubsPtr->tclWinGetTclInstance)() /* 4 */
-#endif
-#ifndef TclWinLoadLibrary
-#define TclWinLoadLibrary(name) \
- (tclIntPlatStubsPtr->tclWinLoadLibrary)(name) /* 5 */
+#define TclWinGetTclInstance \
+ (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#endif
+/* Slot 5 is reserved */
#ifndef TclWinNToHS
-#define TclWinNToHS(ns) \
- (tclIntPlatStubsPtr->tclWinNToHS)(ns) /* 6 */
+#define TclWinNToHS \
+ (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#endif
#ifndef TclWinSetSockOpt
-#define TclWinSetSockOpt(s, level, optname, optval, optlen) \
- (tclIntPlatStubsPtr->tclWinSetSockOpt)(s, level, optname, optval, optlen) /* 7 */
+#define TclWinSetSockOpt \
+ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#endif
#ifndef TclpGetPid
-#define TclpGetPid(pid) \
- (tclIntPlatStubsPtr->tclpGetPid)(pid) /* 8 */
+#define TclpGetPid \
+ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */
#endif
#ifndef TclWinGetPlatformId
-#define TclWinGetPlatformId() \
- (tclIntPlatStubsPtr->tclWinGetPlatformId)() /* 9 */
+#define TclWinGetPlatformId \
+ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#endif
#ifndef TclWinSynchSpawn
-#define TclWinSynchSpawn(args, type, trans, pidPtr) \
- (tclIntPlatStubsPtr->tclWinSynchSpawn)(args, type, trans, pidPtr) /* 10 */
+#define TclWinSynchSpawn \
+ (tclIntPlatStubsPtr->tclWinSynchSpawn) /* 10 */
#endif
#ifndef TclGetAndDetachPids
-#define TclGetAndDetachPids(interp, chan) \
- (tclIntPlatStubsPtr->tclGetAndDetachPids)(interp, chan) /* 11 */
+#define TclGetAndDetachPids \
+ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#endif
#ifndef TclpCloseFile
-#define TclpCloseFile(file) \
- (tclIntPlatStubsPtr->tclpCloseFile)(file) /* 12 */
+#define TclpCloseFile \
+ (tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#endif
#ifndef TclpCreateCommandChannel
-#define TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr) \
- (tclIntPlatStubsPtr->tclpCreateCommandChannel)(readFile, writeFile, errorFile, numPids, pidPtr) /* 13 */
+#define TclpCreateCommandChannel \
+ (tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#endif
#ifndef TclpCreatePipe
-#define TclpCreatePipe(readPipe, writePipe) \
- (tclIntPlatStubsPtr->tclpCreatePipe)(readPipe, writePipe) /* 14 */
+#define TclpCreatePipe \
+ (tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#endif
#ifndef TclpCreateProcess
-#define TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr) \
- (tclIntPlatStubsPtr->tclpCreateProcess)(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr) /* 15 */
-#endif
-#ifndef TclpCreateTempFile
-#define TclpCreateTempFile(contents, namePtr) \
- (tclIntPlatStubsPtr->tclpCreateTempFile)(contents, namePtr) /* 16 */
-#endif
-#ifndef TclpGetTZName
-#define TclpGetTZName() \
- (tclIntPlatStubsPtr->tclpGetTZName)() /* 17 */
+#define TclpCreateProcess \
+ (tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#endif
+/* Slot 16 is reserved */
+/* Slot 17 is reserved */
#ifndef TclpMakeFile
-#define TclpMakeFile(channel, direction) \
- (tclIntPlatStubsPtr->tclpMakeFile)(channel, direction) /* 18 */
+#define TclpMakeFile \
+ (tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#endif
#ifndef TclpOpenFile
-#define TclpOpenFile(fname, mode) \
- (tclIntPlatStubsPtr->tclpOpenFile)(fname, mode) /* 19 */
+#define TclpOpenFile \
+ (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#endif
#ifndef TclWinAddProcess
-#define TclWinAddProcess(hProcess, id) \
- (tclIntPlatStubsPtr->tclWinAddProcess)(hProcess, id) /* 20 */
+#define TclWinAddProcess \
+ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
#endif
#ifndef TclpAsyncMark
-#define TclpAsyncMark(async) \
- (tclIntPlatStubsPtr->tclpAsyncMark)(async) /* 21 */
+#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
#endif /* __WIN32__ */
#ifdef MAC_TCL
#ifndef TclpSysAlloc
-#define TclpSysAlloc(size, isBin) \
- (tclIntPlatStubsPtr->tclpSysAlloc)(size, isBin) /* 0 */
+#define TclpSysAlloc \
+ (tclIntPlatStubsPtr->tclpSysAlloc) /* 0 */
#endif
#ifndef TclpSysFree
-#define TclpSysFree(ptr) \
- (tclIntPlatStubsPtr->tclpSysFree)(ptr) /* 1 */
+#define TclpSysFree \
+ (tclIntPlatStubsPtr->tclpSysFree) /* 1 */
#endif
#ifndef TclpSysRealloc
-#define TclpSysRealloc(cp, size) \
- (tclIntPlatStubsPtr->tclpSysRealloc)(cp, size) /* 2 */
+#define TclpSysRealloc \
+ (tclIntPlatStubsPtr->tclpSysRealloc) /* 2 */
#endif
-#ifndef TclPlatformExit
-#define TclPlatformExit(status) \
- (tclIntPlatStubsPtr->tclPlatformExit)(status) /* 3 */
+#ifndef TclpExit
+#define TclpExit \
+ (tclIntPlatStubsPtr->tclpExit) /* 3 */
#endif
#ifndef FSpGetDefaultDir
-#define FSpGetDefaultDir(theSpec) \
- (tclIntPlatStubsPtr->fSpGetDefaultDir)(theSpec) /* 4 */
+#define FSpGetDefaultDir \
+ (tclIntPlatStubsPtr->fSpGetDefaultDir) /* 4 */
#endif
#ifndef FSpSetDefaultDir
-#define FSpSetDefaultDir(theSpec) \
- (tclIntPlatStubsPtr->fSpSetDefaultDir)(theSpec) /* 5 */
+#define FSpSetDefaultDir \
+ (tclIntPlatStubsPtr->fSpSetDefaultDir) /* 5 */
#endif
#ifndef FSpFindFolder
-#define FSpFindFolder(vRefNum, folderType, createFolder, spec) \
- (tclIntPlatStubsPtr->fSpFindFolder)(vRefNum, folderType, createFolder, spec) /* 6 */
+#define FSpFindFolder \
+ (tclIntPlatStubsPtr->fSpFindFolder) /* 6 */
#endif
#ifndef GetGlobalMouse
-#define GetGlobalMouse(mouse) \
- (tclIntPlatStubsPtr->getGlobalMouse)(mouse) /* 7 */
+#define GetGlobalMouse \
+ (tclIntPlatStubsPtr->getGlobalMouse) /* 7 */
#endif
#ifndef FSpGetDirectoryID
-#define FSpGetDirectoryID(spec, theDirID, isDirectory) \
- (tclIntPlatStubsPtr->fSpGetDirectoryID)(spec, theDirID, isDirectory) /* 8 */
+#define FSpGetDirectoryID \
+ (tclIntPlatStubsPtr->fSpGetDirectoryID) /* 8 */
#endif
#ifndef FSpOpenResFileCompat
-#define FSpOpenResFileCompat(spec, permission) \
- (tclIntPlatStubsPtr->fSpOpenResFileCompat)(spec, permission) /* 9 */
+#define FSpOpenResFileCompat \
+ (tclIntPlatStubsPtr->fSpOpenResFileCompat) /* 9 */
#endif
#ifndef FSpCreateResFileCompat
-#define FSpCreateResFileCompat(spec, creator, fileType, scriptTag) \
- (tclIntPlatStubsPtr->fSpCreateResFileCompat)(spec, creator, fileType, scriptTag) /* 10 */
+#define FSpCreateResFileCompat \
+ (tclIntPlatStubsPtr->fSpCreateResFileCompat) /* 10 */
#endif
#ifndef FSpLocationFromPath
-#define FSpLocationFromPath(length, path, theSpec) \
- (tclIntPlatStubsPtr->fSpLocationFromPath)(length, path, theSpec) /* 11 */
+#define FSpLocationFromPath \
+ (tclIntPlatStubsPtr->fSpLocationFromPath) /* 11 */
#endif
#ifndef FSpPathFromLocation
-#define FSpPathFromLocation(theSpec, length, fullPath) \
- (tclIntPlatStubsPtr->fSpPathFromLocation)(theSpec, length, fullPath) /* 12 */
+#define FSpPathFromLocation \
+ (tclIntPlatStubsPtr->fSpPathFromLocation) /* 12 */
#endif
#ifndef TclMacExitHandler
-#define TclMacExitHandler() \
- (tclIntPlatStubsPtr->tclMacExitHandler)() /* 13 */
+#define TclMacExitHandler \
+ (tclIntPlatStubsPtr->tclMacExitHandler) /* 13 */
#endif
#ifndef TclMacInitExitToShell
-#define TclMacInitExitToShell(usePatch) \
- (tclIntPlatStubsPtr->tclMacInitExitToShell)(usePatch) /* 14 */
+#define TclMacInitExitToShell \
+ (tclIntPlatStubsPtr->tclMacInitExitToShell) /* 14 */
#endif
#ifndef TclMacInstallExitToShellPatch
-#define TclMacInstallExitToShellPatch(newProc) \
- (tclIntPlatStubsPtr->tclMacInstallExitToShellPatch)(newProc) /* 15 */
+#define TclMacInstallExitToShellPatch \
+ (tclIntPlatStubsPtr->tclMacInstallExitToShellPatch) /* 15 */
#endif
#ifndef TclMacOSErrorToPosixError
-#define TclMacOSErrorToPosixError(error) \
- (tclIntPlatStubsPtr->tclMacOSErrorToPosixError)(error) /* 16 */
+#define TclMacOSErrorToPosixError \
+ (tclIntPlatStubsPtr->tclMacOSErrorToPosixError) /* 16 */
#endif
#ifndef TclMacRemoveTimer
-#define TclMacRemoveTimer(timerToken) \
- (tclIntPlatStubsPtr->tclMacRemoveTimer)(timerToken) /* 17 */
+#define TclMacRemoveTimer \
+ (tclIntPlatStubsPtr->tclMacRemoveTimer) /* 17 */
#endif
#ifndef TclMacStartTimer
-#define TclMacStartTimer(ms) \
- (tclIntPlatStubsPtr->tclMacStartTimer)(ms) /* 18 */
+#define TclMacStartTimer \
+ (tclIntPlatStubsPtr->tclMacStartTimer) /* 18 */
#endif
#ifndef TclMacTimerExpired
-#define TclMacTimerExpired(timerToken) \
- (tclIntPlatStubsPtr->tclMacTimerExpired)(timerToken) /* 19 */
+#define TclMacTimerExpired \
+ (tclIntPlatStubsPtr->tclMacTimerExpired) /* 19 */
#endif
#ifndef TclMacRegisterResourceFork
-#define TclMacRegisterResourceFork(fileRef, tokenPtr, insert) \
- (tclIntPlatStubsPtr->tclMacRegisterResourceFork)(fileRef, tokenPtr, insert) /* 20 */
+#define TclMacRegisterResourceFork \
+ (tclIntPlatStubsPtr->tclMacRegisterResourceFork) /* 20 */
#endif
#ifndef TclMacUnRegisterResourceFork
-#define TclMacUnRegisterResourceFork(tokenPtr, resultPtr) \
- (tclIntPlatStubsPtr->tclMacUnRegisterResourceFork)(tokenPtr, resultPtr) /* 21 */
+#define TclMacUnRegisterResourceFork \
+ (tclIntPlatStubsPtr->tclMacUnRegisterResourceFork) /* 21 */
#endif
#ifndef TclMacCreateEnv
-#define TclMacCreateEnv() \
- (tclIntPlatStubsPtr->tclMacCreateEnv)() /* 22 */
+#define TclMacCreateEnv \
+ (tclIntPlatStubsPtr->tclMacCreateEnv) /* 22 */
#endif
#ifndef TclMacFOpenHack
-#define TclMacFOpenHack(path, mode) \
- (tclIntPlatStubsPtr->tclMacFOpenHack)(path, mode) /* 23 */
-#endif
-#ifndef TclMacReadlink
-#define TclMacReadlink(path, buf, size) \
- (tclIntPlatStubsPtr->tclMacReadlink)(path, buf, size) /* 24 */
+#define TclMacFOpenHack \
+ (tclIntPlatStubsPtr->tclMacFOpenHack) /* 23 */
#endif
+/* Slot 24 is reserved */
#ifndef TclMacChmod
-#define TclMacChmod(path, mode) \
- (tclIntPlatStubsPtr->tclMacChmod)(path, mode) /* 25 */
+#define TclMacChmod \
+ (tclIntPlatStubsPtr->tclMacChmod) /* 25 */
#endif
#endif /* MAC_TCL */
diff --git a/generic/tclIntPlatStubs.c b/generic/tclIntPlatStubs.c
deleted file mode 100644
index 2821567..0000000
--- a/generic/tclIntPlatStubs.c
+++ /dev/null
@@ -1,553 +0,0 @@
-/*
- * tclIntPlatStubs.c --
- *
- * This file contains the wrapper functions for the platform dependent
- * unsupported Tcl API.
- *
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * All rights reserved.
- *
- * RCS: @(#) $Id: tclIntPlatStubs.c,v 1.4 1999/03/11 00:19:23 stanton Exp $
- */
-
-#include "tclInt.h"
-#include "tclPort.h"
-
-/*
- * 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 stub functions:
- */
-
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
-/* Slot 0 */
-void
-TclGetAndDetachPids(interp, chan)
- Tcl_Interp * interp;
- Tcl_Channel chan;
-{
- (tclIntPlatStubsPtr->tclGetAndDetachPids)(interp, chan);
-}
-
-/* Slot 1 */
-int
-TclpCloseFile(file)
- TclFile file;
-{
- return (tclIntPlatStubsPtr->tclpCloseFile)(file);
-}
-
-/* Slot 2 */
-Tcl_Channel
-TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
- TclFile readFile;
- TclFile writeFile;
- TclFile errorFile;
- int numPids;
- Tcl_Pid * pidPtr;
-{
- return (tclIntPlatStubsPtr->tclpCreateCommandChannel)(readFile, writeFile, errorFile, numPids, pidPtr);
-}
-
-/* Slot 3 */
-int
-TclpCreatePipe(readPipe, writePipe)
- TclFile * readPipe;
- TclFile * writePipe;
-{
- return (tclIntPlatStubsPtr->tclpCreatePipe)(readPipe, writePipe);
-}
-
-/* Slot 4 */
-int
-TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
- TclFile inputFile;
- TclFile outputFile;
- TclFile errorFile;
- Tcl_Pid * pidPtr;
-{
- return (tclIntPlatStubsPtr->tclpCreateProcess)(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr);
-}
-
-/* Slot 5 */
-TclFile
-TclpCreateTempFile(contents, namePtr)
- char * contents;
- Tcl_DString * namePtr;
-{
- return (tclIntPlatStubsPtr->tclpCreateTempFile)(contents, namePtr);
-}
-
-/* Slot 6 */
-TclFile
-TclpMakeFile(channel, direction)
- Tcl_Channel channel;
- int direction;
-{
- return (tclIntPlatStubsPtr->tclpMakeFile)(channel, direction);
-}
-
-/* Slot 7 */
-TclFile
-TclpOpenFile(fname, mode)
- char * fname;
- int mode;
-{
- return (tclIntPlatStubsPtr->tclpOpenFile)(fname, mode);
-}
-
-/* Slot 8 */
-int
-TclUnixWaitForFile(fd, mask, timeout)
- int fd;
- int mask;
- int timeout;
-{
- return (tclIntPlatStubsPtr->tclUnixWaitForFile)(fd, mask, timeout);
-}
-
-#endif /* UNIX */
-#ifdef __WIN32__
-/* Slot 0 */
-void
-TclWinConvertError(errCode)
- DWORD errCode;
-{
- (tclIntPlatStubsPtr->tclWinConvertError)(errCode);
-}
-
-/* Slot 1 */
-void
-TclWinConvertWSAError(errCode)
- DWORD errCode;
-{
- (tclIntPlatStubsPtr->tclWinConvertWSAError)(errCode);
-}
-
-/* Slot 2 */
-struct servent *
-TclWinGetServByName(nm, proto)
- const char * nm;
- const char * proto;
-{
- return (tclIntPlatStubsPtr->tclWinGetServByName)(nm, proto);
-}
-
-/* Slot 3 */
-int
-TclWinGetSockOpt(s, level, optname, optval, optlen)
- SOCKET s;
- int level;
- int optname;
- char FAR * optval;
- int FAR * optlen;
-{
- return (tclIntPlatStubsPtr->tclWinGetSockOpt)(s, level, optname, optval, optlen);
-}
-
-/* Slot 4 */
-HINSTANCE
-TclWinGetTclInstance()
-{
- return (tclIntPlatStubsPtr->tclWinGetTclInstance)();
-}
-
-/* Slot 5 */
-HINSTANCE
-TclWinLoadLibrary(name)
- char * name;
-{
- return (tclIntPlatStubsPtr->tclWinLoadLibrary)(name);
-}
-
-/* Slot 6 */
-u_short
-TclWinNToHS(ns)
- u_short ns;
-{
- return (tclIntPlatStubsPtr->tclWinNToHS)(ns);
-}
-
-/* Slot 7 */
-int
-TclWinSetSockOpt(s, level, optname, optval, optlen)
- SOCKET s;
- int level;
- int optname;
- const char FAR * optval;
- int optlen;
-{
- return (tclIntPlatStubsPtr->tclWinSetSockOpt)(s, level, optname, optval, optlen);
-}
-
-/* Slot 8 */
-unsigned long
-TclpGetPid(pid)
- Tcl_Pid pid;
-{
- return (tclIntPlatStubsPtr->tclpGetPid)(pid);
-}
-
-/* Slot 9 */
-int
-TclWinGetPlatformId()
-{
- return (tclIntPlatStubsPtr->tclWinGetPlatformId)();
-}
-
-/* Slot 10 */
-int
-TclWinSynchSpawn(args, type, trans, pidPtr)
- void * args;
- int type;
- void ** trans;
- Tcl_Pid * pidPtr;
-{
- return (tclIntPlatStubsPtr->tclWinSynchSpawn)(args, type, trans, pidPtr);
-}
-
-/* Slot 11 */
-void
-TclGetAndDetachPids(interp, chan)
- Tcl_Interp * interp;
- Tcl_Channel chan;
-{
- (tclIntPlatStubsPtr->tclGetAndDetachPids)(interp, chan);
-}
-
-/* Slot 12 */
-int
-TclpCloseFile(file)
- TclFile file;
-{
- return (tclIntPlatStubsPtr->tclpCloseFile)(file);
-}
-
-/* Slot 13 */
-Tcl_Channel
-TclpCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
- TclFile readFile;
- TclFile writeFile;
- TclFile errorFile;
- int numPids;
- Tcl_Pid * pidPtr;
-{
- return (tclIntPlatStubsPtr->tclpCreateCommandChannel)(readFile, writeFile, errorFile, numPids, pidPtr);
-}
-
-/* Slot 14 */
-int
-TclpCreatePipe(readPipe, writePipe)
- TclFile * readPipe;
- TclFile * writePipe;
-{
- return (tclIntPlatStubsPtr->tclpCreatePipe)(readPipe, writePipe);
-}
-
-/* Slot 15 */
-int
-TclpCreateProcess(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
- TclFile inputFile;
- TclFile outputFile;
- TclFile errorFile;
- Tcl_Pid * pidPtr;
-{
- return (tclIntPlatStubsPtr->tclpCreateProcess)(interp, argc, argv, inputFile, outputFile, errorFile, pidPtr);
-}
-
-/* Slot 16 */
-TclFile
-TclpCreateTempFile(contents, namePtr)
- char * contents;
- Tcl_DString * namePtr;
-{
- return (tclIntPlatStubsPtr->tclpCreateTempFile)(contents, namePtr);
-}
-
-/* Slot 17 */
-char *
-TclpGetTZName()
-{
- return (tclIntPlatStubsPtr->tclpGetTZName)();
-}
-
-/* Slot 18 */
-TclFile
-TclpMakeFile(channel, direction)
- Tcl_Channel channel;
- int direction;
-{
- return (tclIntPlatStubsPtr->tclpMakeFile)(channel, direction);
-}
-
-/* Slot 19 */
-TclFile
-TclpOpenFile(fname, mode)
- char * fname;
- int mode;
-{
- return (tclIntPlatStubsPtr->tclpOpenFile)(fname, mode);
-}
-
-/* Slot 20 */
-void
-TclWinAddProcess(hProcess, id)
- HANDLE hProcess;
- DWORD id;
-{
- (tclIntPlatStubsPtr->tclWinAddProcess)(hProcess, id);
-}
-
-/* Slot 21 */
-void
-TclpAsyncMark(async)
- Tcl_AsyncHandler async;
-{
- (tclIntPlatStubsPtr->tclpAsyncMark)(async);
-}
-
-#endif /* __WIN32__ */
-#ifdef MAC_TCL
-/* Slot 0 */
-VOID *
-TclpSysAlloc(size, isBin)
- long size;
- int isBin;
-{
- return (tclIntPlatStubsPtr->tclpSysAlloc)(size, isBin);
-}
-
-/* Slot 1 */
-void
-TclpSysFree(ptr)
- VOID * ptr;
-{
- (tclIntPlatStubsPtr->tclpSysFree)(ptr);
-}
-
-/* Slot 2 */
-VOID *
-TclpSysRealloc(cp, size)
- VOID * cp;
- unsigned int size;
-{
- return (tclIntPlatStubsPtr->tclpSysRealloc)(cp, size);
-}
-
-/* Slot 3 */
-void
-TclPlatformExit(status)
- int status;
-{
- (tclIntPlatStubsPtr->tclPlatformExit)(status);
-}
-
-/* Slot 4 */
-int
-FSpGetDefaultDir(theSpec)
- FSSpecPtr theSpec;
-{
- return (tclIntPlatStubsPtr->fSpGetDefaultDir)(theSpec);
-}
-
-/* Slot 5 */
-int
-FSpSetDefaultDir(theSpec)
- FSSpecPtr theSpec;
-{
- return (tclIntPlatStubsPtr->fSpSetDefaultDir)(theSpec);
-}
-
-/* Slot 6 */
-OSErr
-FSpFindFolder(vRefNum, folderType, createFolder, spec)
- short vRefNum;
- OSType folderType;
- Boolean createFolder;
- FSSpec * spec;
-{
- return (tclIntPlatStubsPtr->fSpFindFolder)(vRefNum, folderType, createFolder, spec);
-}
-
-/* Slot 7 */
-void
-GetGlobalMouse(mouse)
- Point * mouse;
-{
- (tclIntPlatStubsPtr->getGlobalMouse)(mouse);
-}
-
-/* Slot 8 */
-pascal OSErr
-FSpGetDirectoryID(spec, theDirID, isDirectory)
- const FSSpec * spec;
- long * theDirID;
- Boolean * isDirectory;
-{
- return (tclIntPlatStubsPtr->fSpGetDirectoryID)(spec, theDirID, isDirectory);
-}
-
-/* Slot 9 */
-pascal short
-FSpOpenResFileCompat(spec, permission)
- const FSSpec * spec;
- SignedByte permission;
-{
- return (tclIntPlatStubsPtr->fSpOpenResFileCompat)(spec, permission);
-}
-
-/* Slot 10 */
-pascal void
-FSpCreateResFileCompat(spec, creator, fileType, scriptTag)
- const FSSpec * spec;
- OSType creator;
- OSType fileType;
- ScriptCode scriptTag;
-{
- return (tclIntPlatStubsPtr->fSpCreateResFileCompat)(spec, creator, fileType, scriptTag);
-}
-
-/* Slot 11 */
-int
-FSpLocationFromPath(length, path, theSpec)
- int length;
- CONST char * path;
- FSSpecPtr theSpec;
-{
- return (tclIntPlatStubsPtr->fSpLocationFromPath)(length, path, theSpec);
-}
-
-/* Slot 12 */
-OSErr
-FSpPathFromLocation(theSpec, length, fullPath)
- FSSpecPtr theSpec;
- int * length;
- Handle * fullPath;
-{
- return (tclIntPlatStubsPtr->fSpPathFromLocation)(theSpec, length, fullPath);
-}
-
-/* Slot 13 */
-void
-TclMacExitHandler()
-{
- (tclIntPlatStubsPtr->tclMacExitHandler)();
-}
-
-/* Slot 14 */
-void
-TclMacInitExitToShell(usePatch)
- int usePatch;
-{
- (tclIntPlatStubsPtr->tclMacInitExitToShell)(usePatch);
-}
-
-/* Slot 15 */
-OSErr
-TclMacInstallExitToShellPatch(newProc)
- ExitToShellProcPtr newProc;
-{
- return (tclIntPlatStubsPtr->tclMacInstallExitToShellPatch)(newProc);
-}
-
-/* Slot 16 */
-int
-TclMacOSErrorToPosixError(error)
- int error;
-{
- return (tclIntPlatStubsPtr->tclMacOSErrorToPosixError)(error);
-}
-
-/* Slot 17 */
-void
-TclMacRemoveTimer(timerToken)
- void * timerToken;
-{
- (tclIntPlatStubsPtr->tclMacRemoveTimer)(timerToken);
-}
-
-/* Slot 18 */
-void *
-TclMacStartTimer(ms)
- long ms;
-{
- return (tclIntPlatStubsPtr->tclMacStartTimer)(ms);
-}
-
-/* Slot 19 */
-int
-TclMacTimerExpired(timerToken)
- void * timerToken;
-{
- return (tclIntPlatStubsPtr->tclMacTimerExpired)(timerToken);
-}
-
-/* Slot 20 */
-int
-TclMacRegisterResourceFork(fileRef, tokenPtr, insert)
- short fileRef;
- Tcl_Obj * tokenPtr;
- int insert;
-{
- return (tclIntPlatStubsPtr->tclMacRegisterResourceFork)(fileRef, tokenPtr, insert);
-}
-
-/* Slot 21 */
-short
-TclMacUnRegisterResourceFork(tokenPtr, resultPtr)
- char * tokenPtr;
- Tcl_Obj * resultPtr;
-{
- return (tclIntPlatStubsPtr->tclMacUnRegisterResourceFork)(tokenPtr, resultPtr);
-}
-
-/* Slot 22 */
-int
-TclMacCreateEnv()
-{
- return (tclIntPlatStubsPtr->tclMacCreateEnv)();
-}
-
-/* Slot 23 */
-FILE *
-TclMacFOpenHack(path, mode)
- const char * path;
- const char * mode;
-{
- return (tclIntPlatStubsPtr->tclMacFOpenHack)(path, mode);
-}
-
-/* Slot 24 */
-int
-TclMacReadlink(path, buf, size)
- char * path;
- char * buf;
- int size;
-{
- return (tclIntPlatStubsPtr->tclMacReadlink)(path, buf, size);
-}
-
-/* Slot 25 */
-int
-TclMacChmod(path, mode)
- char * path;
- int mode;
-{
- return (tclIntPlatStubsPtr->tclMacChmod)(path, mode);
-}
-
-#endif /* MAC_TCL */
-
-/* !END!: Do not edit above this line. */
diff --git a/generic/tclIntStubs.c b/generic/tclIntStubs.c
deleted file mode 100644
index edf48a3..0000000
--- a/generic/tclIntStubs.c
+++ /dev/null
@@ -1,1333 +0,0 @@
-/*
- * tclIntStubs.c --
- *
- * This file contains the wrapper functions for the platform independent
- * unsupported Tcl API.
- *
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * All rights reserved.
- *
- * RCS: @(#) $Id: tclIntStubs.c,v 1.3 1999/03/10 05:52:49 stanton Exp $
- */
-
-#include "tclInt.h"
-
-/*
- * 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 stub functions:
- */
-
-/* Slot 0 */
-int
-TclAccess(path, mode)
- CONST char * path;
- int mode;
-{
- return (tclIntStubsPtr->tclAccess)(path, mode);
-}
-
-/* Slot 1 */
-int
-TclAccessDeleteProc(proc)
- TclAccessProc_ * proc;
-{
- return (tclIntStubsPtr->tclAccessDeleteProc)(proc);
-}
-
-/* Slot 2 */
-int
-TclAccessInsertProc(proc)
- TclAccessProc_ * proc;
-{
- return (tclIntStubsPtr->tclAccessInsertProc)(proc);
-}
-
-/* Slot 3 */
-void
-TclAllocateFreeObjects()
-{
- (tclIntStubsPtr->tclAllocateFreeObjects)();
-}
-
-/* Slot 4 */
-int
-TclChdir(interp, dirName)
- Tcl_Interp * interp;
- char * dirName;
-{
- return (tclIntStubsPtr->tclChdir)(interp, dirName);
-}
-
-/* Slot 5 */
-int
-TclCleanupChildren(interp, numPids, pidPtr, errorChan)
- Tcl_Interp * interp;
- int numPids;
- Tcl_Pid * pidPtr;
- Tcl_Channel errorChan;
-{
- return (tclIntStubsPtr->tclCleanupChildren)(interp, numPids, pidPtr, errorChan);
-}
-
-/* Slot 6 */
-void
-TclCleanupCommand(cmdPtr)
- Command * cmdPtr;
-{
- (tclIntStubsPtr->tclCleanupCommand)(cmdPtr);
-}
-
-/* Slot 7 */
-int
-TclCopyAndCollapse(count, src, dst)
- int count;
- char * src;
- char * dst;
-{
- return (tclIntStubsPtr->tclCopyAndCollapse)(count, src, dst);
-}
-
-/* Slot 8 */
-int
-TclCopyChannel(interp, inChan, outChan, toRead, cmdPtr)
- Tcl_Interp * interp;
- Tcl_Channel inChan;
- Tcl_Channel outChan;
- int toRead;
- Tcl_Obj * cmdPtr;
-{
- return (tclIntStubsPtr->tclCopyChannel)(interp, inChan, outChan, toRead, cmdPtr);
-}
-
-/* Slot 9 */
-int
-TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr, outPipePtr, errFilePtr)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
- Tcl_Pid ** pidArrayPtr;
- TclFile * inPipePtr;
- TclFile * outPipePtr;
- TclFile * errFilePtr;
-{
- return (tclIntStubsPtr->tclCreatePipeline)(interp, argc, argv, pidArrayPtr, inPipePtr, outPipePtr, errFilePtr);
-}
-
-/* Slot 10 */
-int
-TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
- Tcl_Interp * interp;
- Namespace * nsPtr;
- char * procName;
- Tcl_Obj * argsPtr;
- Tcl_Obj * bodyPtr;
- Proc ** procPtrPtr;
-{
- return (tclIntStubsPtr->tclCreateProc)(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr);
-}
-
-/* Slot 11 */
-void
-TclDeleteCompiledLocalVars(iPtr, framePtr)
- Interp * iPtr;
- CallFrame * framePtr;
-{
- (tclIntStubsPtr->tclDeleteCompiledLocalVars)(iPtr, framePtr);
-}
-
-/* Slot 12 */
-void
-TclDeleteVars(iPtr, tablePtr)
- Interp * iPtr;
- Tcl_HashTable * tablePtr;
-{
- (tclIntStubsPtr->tclDeleteVars)(iPtr, tablePtr);
-}
-
-/* Slot 13 */
-int
-TclDoGlob(interp, separators, headPtr, tail)
- Tcl_Interp * interp;
- char * separators;
- Tcl_DString * headPtr;
- char * tail;
-{
- return (tclIntStubsPtr->tclDoGlob)(interp, separators, headPtr, tail);
-}
-
-/* Slot 14 */
-void
-TclDumpMemoryInfo(outFile)
- FILE * outFile;
-{
- (tclIntStubsPtr->tclDumpMemoryInfo)(outFile);
-}
-
-/* Slot 15 */
-void
-TclExpandParseValue(pvPtr, needed)
- ParseValue * pvPtr;
- int needed;
-{
- (tclIntStubsPtr->tclExpandParseValue)(pvPtr, needed);
-}
-
-/* Slot 16 */
-void
-TclExprFloatError(interp, value)
- Tcl_Interp * interp;
- double value;
-{
- (tclIntStubsPtr->tclExprFloatError)(interp, value);
-}
-
-/* Slot 17 */
-int
-TclFileAttrsCmd(interp, objc, objv)
- Tcl_Interp * interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- return (tclIntStubsPtr->tclFileAttrsCmd)(interp, objc, objv);
-}
-
-/* Slot 18 */
-int
-TclFileCopyCmd(interp, argc, argv)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
-{
- return (tclIntStubsPtr->tclFileCopyCmd)(interp, argc, argv);
-}
-
-/* Slot 19 */
-int
-TclFileDeleteCmd(interp, argc, argv)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
-{
- return (tclIntStubsPtr->tclFileDeleteCmd)(interp, argc, argv);
-}
-
-/* Slot 20 */
-int
-TclFileMakeDirsCmd(interp, argc, argv)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
-{
- return (tclIntStubsPtr->tclFileMakeDirsCmd)(interp, argc, argv);
-}
-
-/* Slot 21 */
-int
-TclFileRenameCmd(interp, argc, argv)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
-{
- return (tclIntStubsPtr->tclFileRenameCmd)(interp, argc, argv);
-}
-
-/* Slot 22 */
-int
-TclFindElement(interp, list, listLength, elementPtr, nextPtr, sizePtr, bracePtr)
- Tcl_Interp * interp;
- char * list;
- int listLength;
- char ** elementPtr;
- char ** nextPtr;
- int * sizePtr;
- int * bracePtr;
-{
- return (tclIntStubsPtr->tclFindElement)(interp, list, listLength, elementPtr, nextPtr, sizePtr, bracePtr);
-}
-
-/* Slot 23 */
-Proc *
-TclFindProc(iPtr, procName)
- Interp * iPtr;
- char * procName;
-{
- return (tclIntStubsPtr->tclFindProc)(iPtr, procName);
-}
-
-/* Slot 24 */
-int
-TclFormatInt(buffer, n)
- char * buffer;
- long n;
-{
- return (tclIntStubsPtr->tclFormatInt)(buffer, n);
-}
-
-/* Slot 25 */
-void
-TclFreePackageInfo(iPtr)
- Interp * iPtr;
-{
- (tclIntStubsPtr->tclFreePackageInfo)(iPtr);
-}
-
-/* Slot 26 */
-char *
-TclGetCwd(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tclGetCwd)(interp);
-}
-
-/* Slot 27 */
-int
-TclGetDate(p, now, zone, timePtr)
- char * p;
- unsigned long now;
- long zone;
- unsigned long * timePtr;
-{
- return (tclIntStubsPtr->tclGetDate)(p, now, zone, timePtr);
-}
-
-/* Slot 28 */
-Tcl_Channel
-TclGetDefaultStdChannel(type)
- int type;
-{
- return (tclIntStubsPtr->tclGetDefaultStdChannel)(type);
-}
-
-/* Slot 29 */
-Tcl_Obj *
-TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
- Tcl_Interp * interp;
- int localIndex;
- Tcl_Obj * elemPtr;
- int leaveErrorMsg;
-{
- return (tclIntStubsPtr->tclGetElementOfIndexedArray)(interp, localIndex, elemPtr, leaveErrorMsg);
-}
-
-/* Slot 30 */
-char *
-TclGetEnv(name)
- CONST char * name;
-{
- return (tclIntStubsPtr->tclGetEnv)(name);
-}
-
-/* Slot 31 */
-char *
-TclGetExtension(name)
- char * name;
-{
- return (tclIntStubsPtr->tclGetExtension)(name);
-}
-
-/* Slot 32 */
-int
-TclGetFrame(interp, string, framePtrPtr)
- Tcl_Interp * interp;
- char * string;
- CallFrame ** framePtrPtr;
-{
- return (tclIntStubsPtr->tclGetFrame)(interp, string, framePtrPtr);
-}
-
-/* Slot 33 */
-TclCmdProcType
-TclGetInterpProc()
-{
- return (tclIntStubsPtr->tclGetInterpProc)();
-}
-
-/* Slot 34 */
-int
-TclGetIntForIndex(interp, objPtr, endValue, indexPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
- int endValue;
- int * indexPtr;
-{
- return (tclIntStubsPtr->tclGetIntForIndex)(interp, objPtr, endValue, indexPtr);
-}
-
-/* Slot 35 */
-Tcl_Obj *
-TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
- Tcl_Interp * interp;
- int localIndex;
- int leaveErrorMsg;
-{
- return (tclIntStubsPtr->tclGetIndexedScalar)(interp, localIndex, leaveErrorMsg);
-}
-
-/* Slot 36 */
-int
-TclGetLong(interp, string, longPtr)
- Tcl_Interp * interp;
- char * string;
- long * longPtr;
-{
- return (tclIntStubsPtr->tclGetLong)(interp, string, longPtr);
-}
-
-/* Slot 37 */
-int
-TclGetLoadedPackages(interp, targetName)
- Tcl_Interp * interp;
- char * targetName;
-{
- return (tclIntStubsPtr->tclGetLoadedPackages)(interp, targetName);
-}
-
-/* Slot 38 */
-int
-TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags, nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr)
- Tcl_Interp * interp;
- char * qualName;
- Namespace * cxtNsPtr;
- int flags;
- Namespace ** nsPtrPtr;
- Namespace ** altNsPtrPtr;
- Namespace ** actualCxtPtrPtr;
- char ** simpleNamePtr;
-{
- return (tclIntStubsPtr->tclGetNamespaceForQualName)(interp, qualName, cxtNsPtr, flags, nsPtrPtr, altNsPtrPtr, actualCxtPtrPtr, simpleNamePtr);
-}
-
-/* Slot 39 */
-TclObjCmdProcType
-TclGetObjInterpProc()
-{
- return (tclIntStubsPtr->tclGetObjInterpProc)();
-}
-
-/* Slot 40 */
-int
-TclGetOpenMode(interp, string, seekFlagPtr)
- Tcl_Interp * interp;
- char * string;
- int * seekFlagPtr;
-{
- return (tclIntStubsPtr->tclGetOpenMode)(interp, string, seekFlagPtr);
-}
-
-/* Slot 41 */
-Tcl_Command
-TclGetOriginalCommand(command)
- Tcl_Command command;
-{
- return (tclIntStubsPtr->tclGetOriginalCommand)(command);
-}
-
-/* Slot 42 */
-char *
-TclGetUserHome(name, bufferPtr)
- char * name;
- Tcl_DString * bufferPtr;
-{
- return (tclIntStubsPtr->tclGetUserHome)(name, bufferPtr);
-}
-
-/* Slot 43 */
-int
-TclGlobalInvoke(interp, argc, argv, flags)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
- int flags;
-{
- return (tclIntStubsPtr->tclGlobalInvoke)(interp, argc, argv, flags);
-}
-
-/* Slot 44 */
-int
-TclGuessPackageName(fileName, bufPtr)
- char * fileName;
- Tcl_DString * bufPtr;
-{
- return (tclIntStubsPtr->tclGuessPackageName)(fileName, bufPtr);
-}
-
-/* Slot 45 */
-int
-TclHideUnsafeCommands(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tclHideUnsafeCommands)(interp);
-}
-
-/* Slot 46 */
-int
-TclInExit()
-{
- return (tclIntStubsPtr->tclInExit)();
-}
-
-/* Slot 47 */
-Tcl_Obj *
-TclIncrElementOfIndexedArray(interp, localIndex, elemPtr, incrAmount)
- Tcl_Interp * interp;
- int localIndex;
- Tcl_Obj * elemPtr;
- long incrAmount;
-{
- return (tclIntStubsPtr->tclIncrElementOfIndexedArray)(interp, localIndex, elemPtr, incrAmount);
-}
-
-/* Slot 48 */
-Tcl_Obj *
-TclIncrIndexedScalar(interp, localIndex, incrAmount)
- Tcl_Interp * interp;
- int localIndex;
- long incrAmount;
-{
- return (tclIntStubsPtr->tclIncrIndexedScalar)(interp, localIndex, incrAmount);
-}
-
-/* Slot 49 */
-Tcl_Obj *
-TclIncrVar2(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed)
- Tcl_Interp * interp;
- Tcl_Obj * part1Ptr;
- Tcl_Obj * part2Ptr;
- long incrAmount;
- int part1NotParsed;
-{
- return (tclIntStubsPtr->tclIncrVar2)(interp, part1Ptr, part2Ptr, incrAmount, part1NotParsed);
-}
-
-/* Slot 50 */
-void
-TclInitCompiledLocals(interp, framePtr, nsPtr)
- Tcl_Interp * interp;
- CallFrame * framePtr;
- Namespace * nsPtr;
-{
- (tclIntStubsPtr->tclInitCompiledLocals)(interp, framePtr, nsPtr);
-}
-
-/* Slot 51 */
-int
-TclInterpInit(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tclInterpInit)(interp);
-}
-
-/* Slot 52 */
-int
-TclInvoke(interp, argc, argv, flags)
- Tcl_Interp * interp;
- int argc;
- char ** argv;
- int flags;
-{
- return (tclIntStubsPtr->tclInvoke)(interp, argc, argv, flags);
-}
-
-/* Slot 53 */
-int
-TclInvokeObjectCommand(clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp * interp;
- int argc;
- char ** argv;
-{
- return (tclIntStubsPtr->tclInvokeObjectCommand)(clientData, interp, argc, argv);
-}
-
-/* Slot 54 */
-int
-TclInvokeStringCommand(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp * interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- return (tclIntStubsPtr->tclInvokeStringCommand)(clientData, interp, objc, objv);
-}
-
-/* Slot 55 */
-Proc *
-TclIsProc(cmdPtr)
- Command * cmdPtr;
-{
- return (tclIntStubsPtr->tclIsProc)(cmdPtr);
-}
-
-/* Slot 56 */
-int
-TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
- Tcl_Interp * interp;
- char * fileName;
- char * sym1;
- char * sym2;
- Tcl_PackageInitProc ** proc1Ptr;
- Tcl_PackageInitProc ** proc2Ptr;
-{
- return (tclIntStubsPtr->tclLoadFile)(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr);
-}
-
-/* Slot 57 */
-int
-TclLooksLikeInt(p)
- char * p;
-{
- return (tclIntStubsPtr->tclLooksLikeInt)(p);
-}
-
-/* Slot 58 */
-Var *
-TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, arrayPtrPtr)
- Tcl_Interp * interp;
- char * part1;
- char * part2;
- int flags;
- char * msg;
- int createPart1;
- int createPart2;
- Var ** arrayPtrPtr;
-{
- return (tclIntStubsPtr->tclLookupVar)(interp, part1, part2, flags, msg, createPart1, createPart2, arrayPtrPtr);
-}
-
-/* Slot 59 */
-int
-TclMatchFiles(interp, separators, dirPtr, pattern, tail)
- Tcl_Interp * interp;
- char * separators;
- Tcl_DString * dirPtr;
- char * pattern;
- char * tail;
-{
- return (tclIntStubsPtr->tclMatchFiles)(interp, separators, dirPtr, pattern, tail);
-}
-
-/* Slot 60 */
-int
-TclNeedSpace(start, end)
- char * start;
- char * end;
-{
- return (tclIntStubsPtr->tclNeedSpace)(start, end);
-}
-
-/* Slot 61 */
-Tcl_Obj *
-TclNewProcBodyObj(procPtr)
- Proc * procPtr;
-{
- return (tclIntStubsPtr->tclNewProcBodyObj)(procPtr);
-}
-
-/* Slot 62 */
-int
-TclObjCommandComplete(cmdPtr)
- Tcl_Obj * cmdPtr;
-{
- return (tclIntStubsPtr->tclObjCommandComplete)(cmdPtr);
-}
-
-/* Slot 63 */
-int
-TclObjInterpProc(clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp * interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- return (tclIntStubsPtr->tclObjInterpProc)(clientData, interp, objc, objv);
-}
-
-/* Slot 64 */
-int
-TclObjInvoke(interp, objc, objv, flags)
- Tcl_Interp * interp;
- int objc;
- Tcl_Obj *CONST objv[];
- int flags;
-{
- return (tclIntStubsPtr->tclObjInvoke)(interp, objc, objv, flags);
-}
-
-/* Slot 65 */
-int
-TclObjInvokeGlobal(interp, objc, objv, flags)
- Tcl_Interp * interp;
- int objc;
- Tcl_Obj *CONST objv[];
- int flags;
-{
- return (tclIntStubsPtr->tclObjInvokeGlobal)(interp, objc, objv, flags);
-}
-
-/* Slot 66 */
-int
-TclOpenFileChannelDeleteProc(proc)
- TclOpenFileChannelProc_ * proc;
-{
- return (tclIntStubsPtr->tclOpenFileChannelDeleteProc)(proc);
-}
-
-/* Slot 67 */
-int
-TclOpenFileChannelInsertProc(proc)
- TclOpenFileChannelProc_ * proc;
-{
- return (tclIntStubsPtr->tclOpenFileChannelInsertProc)(proc);
-}
-
-/* Slot 68 */
-int
-TclpAccess(path, mode)
- CONST char * path;
- int mode;
-{
- return (tclIntStubsPtr->tclpAccess)(path, mode);
-}
-
-/* Slot 69 */
-char *
-TclpAlloc(size)
- unsigned int size;
-{
- return (tclIntStubsPtr->tclpAlloc)(size);
-}
-
-/* Slot 70 */
-int
-TclpCopyFile(source, dest)
- char * source;
- char * dest;
-{
- return (tclIntStubsPtr->tclpCopyFile)(source, dest);
-}
-
-/* Slot 71 */
-int
-TclpCopyDirectory(source, dest, errorPtr)
- char * source;
- char * dest;
- Tcl_DString * errorPtr;
-{
- return (tclIntStubsPtr->tclpCopyDirectory)(source, dest, errorPtr);
-}
-
-/* Slot 72 */
-int
-TclpCreateDirectory(path)
- char * path;
-{
- return (tclIntStubsPtr->tclpCreateDirectory)(path);
-}
-
-/* Slot 73 */
-int
-TclpDeleteFile(path)
- char * path;
-{
- return (tclIntStubsPtr->tclpDeleteFile)(path);
-}
-
-/* Slot 74 */
-void
-TclpFree(ptr)
- char * ptr;
-{
- (tclIntStubsPtr->tclpFree)(ptr);
-}
-
-/* Slot 75 */
-unsigned long
-TclpGetClicks()
-{
- return (tclIntStubsPtr->tclpGetClicks)();
-}
-
-/* Slot 76 */
-unsigned long
-TclpGetSeconds()
-{
- return (tclIntStubsPtr->tclpGetSeconds)();
-}
-
-/* Slot 77 */
-void
-TclpGetTime(time)
- Tcl_Time * time;
-{
- (tclIntStubsPtr->tclpGetTime)(time);
-}
-
-/* Slot 78 */
-int
-TclpGetTimeZone(time)
- unsigned long time;
-{
- return (tclIntStubsPtr->tclpGetTimeZone)(time);
-}
-
-/* Slot 79 */
-int
-TclpListVolumes(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tclpListVolumes)(interp);
-}
-
-/* Slot 80 */
-Tcl_Channel
-TclpOpenFileChannel(interp, fileName, modeString, permissions)
- Tcl_Interp * interp;
- char * fileName;
- char * modeString;
- int permissions;
-{
- return (tclIntStubsPtr->tclpOpenFileChannel)(interp, fileName, modeString, permissions);
-}
-
-/* Slot 81 */
-char *
-TclpRealloc(ptr, size)
- char * ptr;
- unsigned int size;
-{
- return (tclIntStubsPtr->tclpRealloc)(ptr, size);
-}
-
-/* Slot 82 */
-int
-TclpRemoveDirectory(path, recursive, errorPtr)
- char * path;
- int recursive;
- Tcl_DString * errorPtr;
-{
- return (tclIntStubsPtr->tclpRemoveDirectory)(path, recursive, errorPtr);
-}
-
-/* Slot 83 */
-int
-TclpRenameFile(source, dest)
- char * source;
- char * dest;
-{
- return (tclIntStubsPtr->tclpRenameFile)(source, dest);
-}
-
-/* Slot 84 */
-int
-TclParseBraces(interp, string, termPtr, pvPtr)
- Tcl_Interp * interp;
- char * string;
- char ** termPtr;
- ParseValue * pvPtr;
-{
- return (tclIntStubsPtr->tclParseBraces)(interp, string, termPtr, pvPtr);
-}
-
-/* Slot 85 */
-int
-TclParseNestedCmd(interp, string, flags, termPtr, pvPtr)
- Tcl_Interp * interp;
- char * string;
- int flags;
- char ** termPtr;
- ParseValue * pvPtr;
-{
- return (tclIntStubsPtr->tclParseNestedCmd)(interp, string, flags, termPtr, pvPtr);
-}
-
-/* Slot 86 */
-int
-TclParseQuotes(interp, string, termChar, flags, termPtr, pvPtr)
- Tcl_Interp * interp;
- char * string;
- int termChar;
- int flags;
- char ** termPtr;
- ParseValue * pvPtr;
-{
- return (tclIntStubsPtr->tclParseQuotes)(interp, string, termChar, flags, termPtr, pvPtr);
-}
-
-/* Slot 87 */
-void
-TclPlatformInit(interp)
- Tcl_Interp * interp;
-{
- (tclIntStubsPtr->tclPlatformInit)(interp);
-}
-
-/* Slot 88 */
-char *
-TclPrecTraceProc(clientData, interp, name1, name2, flags)
- ClientData clientData;
- Tcl_Interp * interp;
- char * name1;
- char * name2;
- int flags;
-{
- return (tclIntStubsPtr->tclPrecTraceProc)(clientData, interp, name1, name2, flags);
-}
-
-/* Slot 89 */
-int
-TclPreventAliasLoop(interp, cmdInterp, cmd)
- Tcl_Interp * interp;
- Tcl_Interp * cmdInterp;
- Tcl_Command cmd;
-{
- return (tclIntStubsPtr->tclPreventAliasLoop)(interp, cmdInterp, cmd);
-}
-
-/* Slot 90 */
-void
-TclPrintByteCodeObj(interp, objPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
-{
- (tclIntStubsPtr->tclPrintByteCodeObj)(interp, objPtr);
-}
-
-/* Slot 91 */
-void
-TclProcCleanupProc(procPtr)
- Proc * procPtr;
-{
- (tclIntStubsPtr->tclProcCleanupProc)(procPtr);
-}
-
-/* Slot 92 */
-int
-TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
- Tcl_Interp * interp;
- Proc * procPtr;
- Tcl_Obj * bodyPtr;
- Namespace * nsPtr;
- CONST char * description;
- CONST char * procName;
-{
- return (tclIntStubsPtr->tclProcCompileProc)(interp, procPtr, bodyPtr, nsPtr, description, procName);
-}
-
-/* Slot 93 */
-void
-TclProcDeleteProc(clientData)
- ClientData clientData;
-{
- (tclIntStubsPtr->tclProcDeleteProc)(clientData);
-}
-
-/* Slot 94 */
-int
-TclProcInterpProc(clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp * interp;
- int argc;
- char ** argv;
-{
- return (tclIntStubsPtr->tclProcInterpProc)(clientData, interp, argc, argv);
-}
-
-/* Slot 95 */
-int
-TclpStat(path, buf)
- CONST char * path;
- struct stat * buf;
-{
- return (tclIntStubsPtr->tclpStat)(path, buf);
-}
-
-/* Slot 96 */
-int
-TclRenameCommand(interp, oldName, newName)
- Tcl_Interp * interp;
- char * oldName;
- char * newName;
-{
- return (tclIntStubsPtr->tclRenameCommand)(interp, oldName, newName);
-}
-
-/* Slot 97 */
-void
-TclResetShadowedCmdRefs(interp, newCmdPtr)
- Tcl_Interp * interp;
- Command * newCmdPtr;
-{
- (tclIntStubsPtr->tclResetShadowedCmdRefs)(interp, newCmdPtr);
-}
-
-/* Slot 98 */
-int
-TclServiceIdle()
-{
- return (tclIntStubsPtr->tclServiceIdle)();
-}
-
-/* Slot 99 */
-Tcl_Obj *
-TclSetElementOfIndexedArray(interp, localIndex, elemPtr, objPtr, leaveErrorMsg)
- Tcl_Interp * interp;
- int localIndex;
- Tcl_Obj * elemPtr;
- Tcl_Obj * objPtr;
- int leaveErrorMsg;
-{
- return (tclIntStubsPtr->tclSetElementOfIndexedArray)(interp, localIndex, elemPtr, objPtr, leaveErrorMsg);
-}
-
-/* Slot 100 */
-Tcl_Obj *
-TclSetIndexedScalar(interp, localIndex, objPtr, leaveErrorMsg)
- Tcl_Interp * interp;
- int localIndex;
- Tcl_Obj * objPtr;
- int leaveErrorMsg;
-{
- return (tclIntStubsPtr->tclSetIndexedScalar)(interp, localIndex, objPtr, leaveErrorMsg);
-}
-
-/* Slot 101 */
-char *
-TclSetPreInitScript(string)
- char * string;
-{
- return (tclIntStubsPtr->tclSetPreInitScript)(string);
-}
-
-/* Slot 102 */
-void
-TclSetupEnv(interp)
- Tcl_Interp * interp;
-{
- (tclIntStubsPtr->tclSetupEnv)(interp);
-}
-
-/* Slot 103 */
-int
-TclSockGetPort(interp, string, proto, portPtr)
- Tcl_Interp * interp;
- char * string;
- char * proto;
- int * portPtr;
-{
- return (tclIntStubsPtr->tclSockGetPort)(interp, string, proto, portPtr);
-}
-
-/* Slot 104 */
-int
-TclSockMinimumBuffers(sock, size)
- int sock;
- int size;
-{
- return (tclIntStubsPtr->tclSockMinimumBuffers)(sock, size);
-}
-
-/* Slot 105 */
-int
-TclStat(path, buf)
- CONST char * path;
- TclStat_ * buf;
-{
- return (tclIntStubsPtr->tclStat)(path, buf);
-}
-
-/* Slot 106 */
-int
-TclStatDeleteProc(proc)
- TclStatProc_ * proc;
-{
- return (tclIntStubsPtr->tclStatDeleteProc)(proc);
-}
-
-/* Slot 107 */
-int
-TclStatInsertProc(proc)
- TclStatProc_ * proc;
-{
- return (tclIntStubsPtr->tclStatInsertProc)(proc);
-}
-
-/* Slot 108 */
-void
-TclTeardownNamespace(nsPtr)
- Namespace * nsPtr;
-{
- (tclIntStubsPtr->tclTeardownNamespace)(nsPtr);
-}
-
-/* Slot 109 */
-int
-TclUpdateReturnInfo(iPtr)
- Interp * iPtr;
-{
- return (tclIntStubsPtr->tclUpdateReturnInfo)(iPtr);
-}
-
-/* Slot 110 */
-char *
-TclWordEnd(start, lastChar, nested, semiPtr)
- char * start;
- char * lastChar;
- int nested;
- int * semiPtr;
-{
- return (tclIntStubsPtr->tclWordEnd)(start, lastChar, nested, semiPtr);
-}
-
-/* Slot 111 */
-void
-Tcl_AddInterpResolvers(interp, name, cmdProc, varProc, compiledVarProc)
- Tcl_Interp * interp;
- char * name;
- Tcl_ResolveCmdProc * cmdProc;
- Tcl_ResolveVarProc * varProc;
- Tcl_ResolveCompiledVarProc * compiledVarProc;
-{
- (tclIntStubsPtr->tcl_AddInterpResolvers)(interp, name, cmdProc, varProc, compiledVarProc);
-}
-
-/* Slot 112 */
-int
-Tcl_AppendExportList(interp, nsPtr, objPtr)
- Tcl_Interp * interp;
- Tcl_Namespace * nsPtr;
- Tcl_Obj * objPtr;
-{
- return (tclIntStubsPtr->tcl_AppendExportList)(interp, nsPtr, objPtr);
-}
-
-/* Slot 113 */
-Tcl_Namespace *
-Tcl_CreateNamespace(interp, name, clientData, deleteProc)
- Tcl_Interp * interp;
- char * name;
- ClientData clientData;
- Tcl_NamespaceDeleteProc * deleteProc;
-{
- return (tclIntStubsPtr->tcl_CreateNamespace)(interp, name, clientData, deleteProc);
-}
-
-/* Slot 114 */
-void
-Tcl_DeleteNamespace(nsPtr)
- Tcl_Namespace * nsPtr;
-{
- (tclIntStubsPtr->tcl_DeleteNamespace)(nsPtr);
-}
-
-/* Slot 115 */
-int
-Tcl_Export(interp, nsPtr, pattern, resetListFirst)
- Tcl_Interp * interp;
- Tcl_Namespace * nsPtr;
- char * pattern;
- int resetListFirst;
-{
- return (tclIntStubsPtr->tcl_Export)(interp, nsPtr, pattern, resetListFirst);
-}
-
-/* Slot 116 */
-Tcl_Command
-Tcl_FindCommand(interp, name, contextNsPtr, flags)
- Tcl_Interp * interp;
- char * name;
- Tcl_Namespace * contextNsPtr;
- int flags;
-{
- return (tclIntStubsPtr->tcl_FindCommand)(interp, name, contextNsPtr, flags);
-}
-
-/* Slot 117 */
-Tcl_Namespace *
-Tcl_FindNamespace(interp, name, contextNsPtr, flags)
- Tcl_Interp * interp;
- char * name;
- Tcl_Namespace * contextNsPtr;
- int flags;
-{
- return (tclIntStubsPtr->tcl_FindNamespace)(interp, name, contextNsPtr, flags);
-}
-
-/* Slot 118 */
-int
-Tcl_GetInterpResolvers(interp, name, resInfo)
- Tcl_Interp * interp;
- char * name;
- Tcl_ResolverInfo * resInfo;
-{
- return (tclIntStubsPtr->tcl_GetInterpResolvers)(interp, name, resInfo);
-}
-
-/* Slot 119 */
-int
-Tcl_GetNamespaceResolvers(namespacePtr, resInfo)
- Tcl_Namespace * namespacePtr;
- Tcl_ResolverInfo * resInfo;
-{
- return (tclIntStubsPtr->tcl_GetNamespaceResolvers)(namespacePtr, resInfo);
-}
-
-/* Slot 120 */
-Tcl_Var
-Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
- Tcl_Interp * interp;
- char * name;
- Tcl_Namespace * contextNsPtr;
- int flags;
-{
- return (tclIntStubsPtr->tcl_FindNamespaceVar)(interp, name, contextNsPtr, flags);
-}
-
-/* Slot 121 */
-int
-Tcl_ForgetImport(interp, nsPtr, pattern)
- Tcl_Interp * interp;
- Tcl_Namespace * nsPtr;
- char * pattern;
-{
- return (tclIntStubsPtr->tcl_ForgetImport)(interp, nsPtr, pattern);
-}
-
-/* Slot 122 */
-Tcl_Command
-Tcl_GetCommandFromObj(interp, objPtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
-{
- return (tclIntStubsPtr->tcl_GetCommandFromObj)(interp, objPtr);
-}
-
-/* Slot 123 */
-void
-Tcl_GetCommandFullName(interp, command, objPtr)
- Tcl_Interp * interp;
- Tcl_Command command;
- Tcl_Obj * objPtr;
-{
- (tclIntStubsPtr->tcl_GetCommandFullName)(interp, command, objPtr);
-}
-
-/* Slot 124 */
-Tcl_Namespace *
-Tcl_GetCurrentNamespace(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tcl_GetCurrentNamespace)(interp);
-}
-
-/* Slot 125 */
-Tcl_Namespace *
-Tcl_GetGlobalNamespace(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tcl_GetGlobalNamespace)(interp);
-}
-
-/* Slot 126 */
-void
-Tcl_GetVariableFullName(interp, variable, objPtr)
- Tcl_Interp * interp;
- Tcl_Var variable;
- Tcl_Obj * objPtr;
-{
- (tclIntStubsPtr->tcl_GetVariableFullName)(interp, variable, objPtr);
-}
-
-/* Slot 127 */
-int
-Tcl_Import(interp, nsPtr, pattern, allowOverwrite)
- Tcl_Interp * interp;
- Tcl_Namespace * nsPtr;
- char * pattern;
- int allowOverwrite;
-{
- return (tclIntStubsPtr->tcl_Import)(interp, nsPtr, pattern, allowOverwrite);
-}
-
-/* Slot 128 */
-void
-Tcl_PopCallFrame(interp)
- Tcl_Interp* interp;
-{
- (tclIntStubsPtr->tcl_PopCallFrame)(interp);
-}
-
-/* Slot 129 */
-int
-Tcl_PushCallFrame(interp, framePtr, nsPtr, isProcCallFrame)
- Tcl_Interp* interp;
- Tcl_CallFrame * framePtr;
- Tcl_Namespace * nsPtr;
- int isProcCallFrame;
-{
- return (tclIntStubsPtr->tcl_PushCallFrame)(interp, framePtr, nsPtr, isProcCallFrame);
-}
-
-/* Slot 130 */
-int
-Tcl_RemoveInterpResolvers(interp, name)
- Tcl_Interp * interp;
- char * name;
-{
- return (tclIntStubsPtr->tcl_RemoveInterpResolvers)(interp, name);
-}
-
-/* Slot 131 */
-void
-Tcl_SetNamespaceResolvers(namespacePtr, cmdProc, varProc, compiledVarProc)
- Tcl_Namespace * namespacePtr;
- Tcl_ResolveCmdProc * cmdProc;
- Tcl_ResolveVarProc * varProc;
- Tcl_ResolveCompiledVarProc * compiledVarProc;
-{
- (tclIntStubsPtr->tcl_SetNamespaceResolvers)(namespacePtr, cmdProc, varProc, compiledVarProc);
-}
-
-/* Slot 132 */
-int
-TclHasSockets(interp)
- Tcl_Interp * interp;
-{
- return (tclIntStubsPtr->tclHasSockets)(interp);
-}
-
-/* Slot 133 */
-struct tm *
-TclpGetDate(time, useGMT)
- TclpTime_t time;
- int useGMT;
-{
- return (tclIntStubsPtr->tclpGetDate)(time, useGMT);
-}
-
-/* Slot 134 */
-size_t
-TclStrftime(s, maxsize, format, t)
- char * s;
- size_t maxsize;
- const char * format;
- const struct tm * t;
-{
- return (tclIntStubsPtr->tclStrftime)(s, maxsize, format, t);
-}
-
-/* Slot 135 */
-int
-TclpCheckStackSpace()
-{
- return (tclIntStubsPtr->tclpCheckStackSpace)();
-}
-
-
-/* !END!: Do not edit above this line. */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index bdf4f72..a5e7563 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.4 1999/02/03 02:58:40 stanton Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.5 1999/04/16 00:46:49 stanton Exp $
*/
#include <stdio.h>
@@ -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.
+ * Adds the "interp" command to an interpreter and initializes the
+ * interpInfoPtr field of the invoking interpreter.
*
- * NOTE:
- * This function is public internal (instead of being static to
- * this file) because it is also used from TclRenameCommand.
- *
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
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;
+
+ /*
+ * If we are not creating or renaming an alias, then it is
+ * always OK to create or rename the command.
+ */
- for (i = 2; i < objc; i++) {
- if (DeleteOneInterpObject(interp, masterPtr,
- Tcl_GetStringFromObj(objv[i], &len))
- != TCL_OK) {
+ 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. */
-
- 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;
- }
+ TclTransferResult(targetInterp, result, interp);
- 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,103 +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. */
-
- 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.
- */
+ Slave *slavePtr; /* Slave record of this interpreter. */
- 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;
+ if (interp == (Tcl_Interp *) NULL) {
+ return NULL;
}
- aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
-
- /*
- * 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.
- */
-
- (void) Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
-
- return TCL_OK;
+ slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
+ return slavePtr->masterInterp;
}
/*
@@ -2071,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;
- }
- slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
- NULL);
- if (slavePtr == (Slave *) NULL) {
- return TCL_ERROR;
+ if (targetInterp == NULL) {
+ return TCL_ERROR;
}
- if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
-
- /*
- * The result of askingInterp was set by recursive call.
- */
-
+ iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
+ if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {
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");
+ if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
+ return NULL;
}
- 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;
- }
- 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.
*/
- 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));
+ 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().
+ */
+
+ 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.
*
@@ -2394,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);
+ Tcl_AllowExceptions(slaveInterp);
- /*
- * 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);
- }
-
- /*
- * 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.
*
@@ -2486,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;
}
@@ -2520,7 +2074,7 @@ SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SlaveHideHelper --
+ * SlaveHide --
*
* Helper function to hide a command in a slave interpreter.
*
@@ -2535,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;
}
@@ -2569,7 +2116,7 @@ SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SlaveHiddenHelper --
+ * SlaveHidden --
*
* Helper function to compute list of hidden commands in a slave
* interpreter.
@@ -2584,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.
*
@@ -2669,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;
}
@@ -2766,7 +2207,7 @@ SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
/*
*----------------------------------------------------------------------
*
- * SlaveMarkTrustedHelper --
+ * SlaveMarkTrusted --
*
* Helper function to mark a slave interpreter as trusted (unsafe).
*
@@ -2781,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;
}
@@ -3486,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/generic/tclLink.c b/generic/tclLink.c
index ca20e38..20f9191 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -8,12 +8,12 @@
* 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.
*
- * RCS: @(#) $Id: tclLink.c,v 1.2 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.3 1999/04/16 00:46:49 stanton Exp $
*/
#include "tclInt.h"
@@ -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/generic/tclListObj.c b/generic/tclListObj.c
index 1b943a6..aceaa7a 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.3 1998/10/13 20:30:23 rjohnson Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.4 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
@@ -239,11 +239,13 @@ Tcl_SetListObj(objPtr, objc, objv)
Tcl_InvalidateStringRep(objPtr);
if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) {
oldTypePtr->freeIntRepProc(objPtr);
- objPtr->typePtr = NULL;
}
+ objPtr->typePtr = NULL;
/*
* 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) {
@@ -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;
@@ -889,7 +892,7 @@ SetListFromAny(interp, objPtr)
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
/*
* Parse the string into separate string objects, and create a List
@@ -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/generic/tclLiteral.c b/generic/tclLiteral.c
new file mode 100644
index 0000000..eb199bb
--- /dev/null
+++ b/generic/tclLiteral.c
@@ -0,0 +1,929 @@
+/*
+ * 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: tclLiteral.c,v 1.2 1999/04/16 00:46:50 stanton Exp $
+ */
+
+#include "tclInt.h"
+#include "tclCompile.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)) {
+ if (TclGetLong((Tcl_Interp *) NULL, bytes, &n) == TCL_OK) {
+ TclFormatInt(buf, n);
+ if (strcmp(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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ register LiteralEntry *localPtr;
+ int objIndex;
+
+ if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
+ ExpandLocalLiteralArray(envPtr);
+ }
+ objIndex = envPtr->literalArrayNext;
+ envPtr->literalArrayNext++;
+
+ localPtr = &(envPtr->literalArrayPtr[objIndex]);
+ localPtr->objPtr = globalPtr->objPtr;
+ localPtr->refCount = -1; /* i.e., unused */
+ 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);
+ 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--;
+ TclDecrRefCount(objPtr);
+ }
+ return;
+ }
+ }
+#ifdef TCL_COMPILE_DEBUG
+ panic("TclReleaseLiteral: literal \"%.*s\" not found",
+ (length>60? 60 : length), bytes);
+#endif /*TCL_COMPILE_DEBUG*/
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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/generic/tclLoad.c b/generic/tclLoad.c
index 055dcee..68a0f8c 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -4,12 +4,12 @@
* 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.
*
- * RCS: @(#) $Id: tclLoad.c,v 1.2 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclLoad.c,v 1.3 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
@@ -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,26 @@ 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 (pkgPtr->fileName[0] != '\0') {
+ TclpUnloadFile(pkgPtr->clientData);
+ }
ckfree(pkgPtr->fileName);
ckfree(pkgPtr->packageName);
ckfree((char *) pkgPtr);
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index 16c0a5a..ca0046e 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -5,12 +5,12 @@
* 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.
*
- * RCS: @(#) $Id: tclLoadNone.c,v 1.2 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclLoadNone.c,v 1.3 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
@@ -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.
diff --git a/generic/tclMain.c b/generic/tclMain.c
index a0d9397..089452d 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -4,12 +4,12 @@
* 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.
*
- * RCS: @(#) $Id: tclMain.c,v 1.4 1998/09/14 18:40:00 stanton Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.5 1999/04/16 00:46:50 stanton Exp $
*/
#include "tcl.h"
@@ -40,24 +40,6 @@ 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. */
-
-#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:
- */
-
-#ifdef TCL_MEM_DEBUG
-static int CheckmemCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-#endif
/*
*----------------------------------------------------------------------
@@ -88,21 +70,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, *fileName;
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
/*
@@ -118,12 +98,20 @@ Tcl_Main(argc, argv, appInitProc)
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 (fileName == NULL) {
+ Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
+ } else {
+ fileName = Tcl_ExternalToUtfDString(NULL, fileName, -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.
@@ -140,10 +128,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);
}
}
@@ -163,14 +151,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 +176,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 +184,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)");
@@ -257,24 +240,20 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_SetObjLength(commandPtr, 0);
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 +270,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/generic/tclNamesp.c b/generic/tclNamesp.c
index d3fe249..b01cb84 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.10 1999/02/03 21:28:01 stanton Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.11 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
@@ -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);
}
/*
@@ -298,8 +288,8 @@ Tcl_PushCallFrame(interp, callFramePtr, namespacePtr, isProcCallFrame)
} else {
nsPtr = (Namespace *) namespacePtr;
if (nsPtr->flags & NS_DEAD) {
- panic("Trying to push call frame for dead namespace");
- /*NOTREACHED*/
+ panic("Trying to push call frame for dead namespace");
+ /*NOTREACHED*/
}
}
@@ -479,9 +469,9 @@ Tcl_CreateNamespace(interp, name, clientData, deleteProc)
* Find the parent for the new namespace.
*/
- TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
- /*flags*/ CREATE_NS_IF_UNKNOWN, &parentPtr, &dummy1Ptr,
- &dummy2Ptr, &simpleName);
+ TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
+ /*flags*/ (CREATE_NS_IF_UNKNOWN | TCL_LEAVE_ERR_MSG),
+ &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);
/*
* If the unqualified name at the end is empty, there were trailing
@@ -512,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));
@@ -522,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;
@@ -953,7 +945,8 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
*/
TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ 0, &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
+ /*flags*/ TCL_LEAVE_ERR_MSG, &exportNsPtr, &dummyPtr,
+ &dummyPtr, &simplePattern);
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -1105,7 +1098,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;
@@ -1165,7 +1158,8 @@ Tcl_Import(interp, namespacePtr, pattern, allowOverwrite)
return TCL_ERROR;
}
TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ 0, &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);
+ /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
+ &dummyPtr, &simplePattern);
if (importNsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -1238,8 +1232,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,
@@ -1327,7 +1343,8 @@ Tcl_ForgetImport(interp, namespacePtr, pattern)
*/
TclGetNamespaceForQualName(interp, pattern, nsPtr,
- /*flags*/ 0, &importNsPtr, &dummyPtr, &actualCtxPtr, &simplePattern);
+ /*flags*/ TCL_LEAVE_ERR_MSG, &importNsPtr, &dummyPtr,
+ &actualCtxPtr, &simplePattern);
if (importNsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -1540,16 +1557,21 @@ DeleteImportedCmd(clientData)
* final component is stored in *simpleNamePtr.
*
* Results:
- * 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"
+ * contains TCL_LEAVE_ERR_MSG, an error message is returned in the
+ * interpreter's result object. Otherwise, the interpreter's result
+ * object is left unchanged.
+ *
* *actualCxtPtrPtr is set to the actual context namespace. It is
* set to the input context namespace pointer in cxtNsPtr. If cxtNsPtr
* is NULL, it is set to the current namespace context.
@@ -1558,8 +1580,8 @@ DeleteImportedCmd(clientData)
* this function always returns TCL_OK.
*
* Side effects:
- * If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
- * created.
+ * If "flags" contains CREATE_NS_IF_UNKNOWN, new namespaces may be
+ * created.
*
*----------------------------------------------------------------------
*/
@@ -1709,7 +1731,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
*altNsPtrPtr = altNsPtr;
*simpleNamePtr = start;
Tcl_DStringFree(&buffer);
- return TCL_OK;
+ return TCL_OK;
}
} else {
/*
@@ -1739,7 +1761,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
} else if (flags & CREATE_NS_IF_UNKNOWN) {
Tcl_CallFrame frame;
- (void) Tcl_PushCallFrame(interp, &frame,
+ (void) Tcl_PushCallFrame(interp, &frame,
(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);
nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
@@ -1747,7 +1769,7 @@ TclGetNamespaceForQualName(interp, qualName, cxtNsPtr, flags,
Tcl_PopCallFrame(interp);
if (nsPtr == NULL) {
- panic("Could not create namespace '%s'", nsName);
+ panic("Could not create namespace '%s'", nsName);
}
} else { /* namespace not found and wasn't created */
nsPtr = NULL;
@@ -1858,8 +1880,8 @@ Tcl_FindNamespace(interp, name, contextNsPtr, flags)
*/
TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
- (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
-
+ (flags | FIND_ONLY_NS), &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+
if (nsPtr != NULL) {
return (Tcl_Namespace *) nsPtr;
} else if (flags & TCL_LEAVE_ERR_MSG) {
@@ -1971,7 +1993,7 @@ Tcl_FindCommand(interp, name, contextNsPtr, flags)
*/
TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
- flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+ flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
/*
* Look for the command in the command table of its namespace.
@@ -2101,7 +2123,7 @@ Tcl_FindNamespaceVar(interp, name, contextNsPtr, flags)
*/
TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
- flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
+ flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
/*
* Look for the variable in the variable table of its namespace.
@@ -2416,8 +2438,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 ...?");
@@ -2530,8 +2552,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;
}
@@ -2547,7 +2568,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;
@@ -2781,13 +2802,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;
}
@@ -2798,7 +2818,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) {
@@ -2888,14 +2908,19 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
}
if (objc == 4) {
- result = Tcl_EvalObj(interp, objv[3]);
+ result = Tcl_EvalObjEx(interp, objv[3], 0);
} else {
objPtr = Tcl_ConcatObj(objc-3, objv+3);
- result = Tcl_EvalObj(interp, objPtr);
- Tcl_DecrRefCount(objPtr); /* we're done with the object */
+
+ /*
+ * Tcl_EvalObj will delete the object when it decrements its
+ * refcount after eval'ing it.
+ */
+
+ 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);
@@ -2970,7 +2995,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++;
@@ -3003,7 +3028,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) {
@@ -3059,7 +3084,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;
@@ -3129,7 +3154,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++;
@@ -3141,7 +3166,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) {
@@ -3215,8 +3240,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;
}
@@ -3239,7 +3263,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;
@@ -3256,13 +3280,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)",
@@ -3324,8 +3346,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;
}
@@ -3384,8 +3405,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;
}
@@ -3451,7 +3471,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 */
}
@@ -3517,7 +3537,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 */
}
@@ -3581,7 +3601,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;
@@ -3606,7 +3626,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) {
@@ -3745,7 +3765,7 @@ SetNsNameFromAny(interp, objPtr)
name = objPtr->bytes;
if (name == NULL) {
- name = Tcl_GetStringFromObj(objPtr, (int *) NULL);
+ name = Tcl_GetString(objPtr);
}
/*
@@ -3756,7 +3776,7 @@ SetNsNameFromAny(interp, objPtr)
*/
TclGetNamespaceForQualName(interp, name, (Namespace *) NULL,
- /*flags*/ FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+ FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
/*
* If we found a namespace, then create a new ResolvedNsName structure
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index 13c5a13..15553b9 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -13,19 +13,13 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNotify.c,v 1.3 1998/10/14 21:12:09 rjohnson Exp $
+ * RCS: @(#) $Id: tclNotify.c,v 1.4 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
/*
- * The following static indicates whether this module has been initialized.
- */
-
-static int initialized = 0;
-
-/*
* For each event source (created with Tcl_CreateEventSource) there
* is a structure of the following type:
*/
@@ -38,21 +32,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 +61,103 @@ 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.
+ * None.
*
* Side effects:
- * Clears the notifier intialization flag.
+ * Removes the notifier associated with the current thread from
+ * the global notifier list.
*
*----------------------------------------------------------------------
*/
-static void
-NotifierExitHandler(clientData)
- ClientData clientData; /* Not used. */
+void
+TclFinalizeNotifier()
{
- initialized = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData **prevPtrPtr;
+
+ Tcl_MutexLock(&listLock);
+
+ Tcl_FinalizeNotifier(tsdPtr->clientData);
+ TclFinalizeMutex(&(tsdPtr->queueMutex));
+ for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
+ prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
+ if (*prevPtrPtr == tsdPtr) {
+ *prevPtrPtr = tsdPtr->nextPtr;
+ break;
+ }
+ }
+
+ Tcl_MutexUnlock(&listLock);
}
/*
@@ -140,12 +178,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 +205,14 @@ Tcl_CreateEventSource(setupProc, checkProc, clientData)
ClientData clientData; /* One-word argument to pass to
* setupProc and checkProc. */
{
- EventSource *sourcePtr;
-
- if (!initialized) {
- InitNotifier();
- }
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
- 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 +243,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 +255,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 +269,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 +292,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 +431,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 +449,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 +475,7 @@ Tcl_DeleteEvents(proc, clientData)
evPtr = evPtr->nextPtr;
}
}
+ Tcl_MutexUnlock(&(tsdPtr->queueMutex));
}
/*
@@ -367,7 +484,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 +510,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 +537,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 +557,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 +617,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 +641,9 @@ Tcl_ServiceEvent(flags)
int
Tcl_GetServiceMode()
{
- if (!initialized) {
- InitNotifier();
- }
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- return notifier.serviceMode;
+ return tsdPtr->serviceMode;
}
/*
@@ -515,13 +651,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 +668,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 +690,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 +699,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 +715,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 +758,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 +783,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 +820,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 +832,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 +862,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 +915,7 @@ Tcl_DoOneEvent(flags)
}
- notifier.serviceMode = oldMode;
+ tsdPtr->serviceMode = oldMode;
return result;
}
@@ -816,12 +945,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 +956,7 @@ Tcl_ServiceAll()
* to avoid recursive calls.
*/
- notifier.serviceMode = TCL_SERVICE_NONE;
+ tsdPtr->serviceMode = TCL_SERVICE_NONE;
/*
* Check async handlers first.
@@ -846,16 +972,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 +995,52 @@ 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/generic/tclObj.c b/generic/tclObj.c
index b053296..c4895ee 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.4 1999/03/10 05:52:49 stanton Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.5 1999/04/16 00:46:50 stanton Exp $
*/
#include "tclInt.h"
@@ -21,24 +21,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 +61,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 +81,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 +89,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 +97,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,20 +116,19 @@ 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);
@@ -137,86 +138,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();
}
/*
@@ -247,14 +209,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);
@@ -268,6 +226,7 @@ Tcl_RegisterObjType(typePtr)
if (new) {
Tcl_SetHashValue(hPtr, typePtr);
}
+ Tcl_MutexUnlock(&tableMutex);
}
/*
@@ -278,7 +237,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.
*
@@ -307,23 +266,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;
}
@@ -352,15 +310,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;
}
@@ -446,9 +403,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();
}
@@ -462,6 +421,7 @@ Tcl_NewObj()
#ifdef TCL_COMPILE_STATS
tclObjsAlloced++;
#endif /* TCL_COMPILE_STATS */
+ Tcl_MutexUnlock(&tclObjMutex);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -506,7 +466,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);
@@ -515,7 +476,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;
}
@@ -541,6 +504,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.
*
@@ -616,17 +581,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
@@ -634,9 +600,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);
}
/*
@@ -692,7 +659,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;
}
@@ -700,6 +672,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
@@ -735,7 +745,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;
}
@@ -960,33 +974,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
@@ -1021,7 +1008,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.
@@ -1029,8 +1016,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 (isupper(UCHAR(c))) { /* INTL: ISO only. */
+ c = (char) UCHAR(tolower(UCHAR(c))); /* INTL: ISO only. */
}
lowerCase[i] = c;
}
@@ -1081,7 +1076,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)) {
@@ -1341,33 +1337,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
@@ -1399,7 +1368,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
@@ -1436,7 +1405,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)) {
@@ -1648,33 +1618,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
@@ -1707,7 +1650,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
@@ -1718,7 +1661,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 == '-') {
@@ -1759,7 +1702,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)) {
@@ -1805,7 +1749,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);
@@ -2045,7 +1989,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
@@ -2068,9 +2013,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:
@@ -2084,7 +2029,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
@@ -2108,25 +2054,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/generic/tclParse.c b/generic/tclParse.c
index b822c24..679b039 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -1,727 +1,1744 @@
/*
* 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.
*
- * RCS: @(#) $Id: tclParse.c,v 1.2 1998/09/14 18:40:01 stanton Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.3 1999/04/16 00:46:51 stanton Exp $
*/
#include "tclInt.h"
#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->interp = interp;
+ parsePtr->incomplete = 0;
+ 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];
+ 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++;
+ }
+ }
+ }
+
+ /*
+ * The following loop parses the words of the command, one word
+ * in each iteration through the loop.
+ */
+
+ 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;
- 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;
+ /*
+ * Skip white space before the word. Also skip a backslash-newline
+ * sequence: it should be treated just like white space.
+ */
- value = Tcl_ParseVar(interp, src-1, termPtr);
- if (value == NULL) {
- return TCL_ERROR;
+ 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) {
+ 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;
+ }
- src--;
- *dst = Tcl_Backslash(src, &numRead);
- dst++;
- src += numRead;
+ /*
+ * 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.
+ */
+
+ 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) {
+ src++;
+ break;
}
+ if (src == parsePtr->end) {
+ break;
+ }
+ if (interp != NULL) {
+ if (src[-1] == '"') {
+ Tcl_SetResult(interp, "extra characters after close-quote",
+ TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "extra characters after close-brace",
+ TCL_STATIC);
+ }
+ }
+ parsePtr->term = src;
+ goto error;
+ }
+
+
+ parsePtr->commandSize = src - parsePtr->commandStart;
+ string[numBytes] = (char) savedChar;
+ return TCL_OK;
+
+ error:
+ string[numBytes] = (char) savedChar;
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ 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.
+ */
+
+ originalTokens = parsePtr->numTokens;
+ while (1) {
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
- if (**termPtr == ']') {
- *termPtr += 1;
+ 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->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 ((src[-1] == ']') && !nested.incomplete) {
+ break;
+ }
+ if (src == parsePtr->end) {
+ if (parsePtr->interp != NULL) {
+ Tcl_SetResult(parsePtr->interp,
+ "missing close-bracket", TCL_STATIC);
+ }
+ 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 = parsePtr->staticTokens;
+ }
+ 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;
+ Interp *iPtr = (Interp *)interp;
+ Trace *tracePtr;
+ Tcl_DString cmdBuf;
+ char *cmdString = "";
+ int cmdLen = 0;
+ int code = TCL_OK;
- /*
- * Either double the size of the buffer or add enough new space
- * to meet the demand, whichever produces a larger new buffer.
- */
-
- 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 (iPtr->flags & ERR_ALREADY_LOGGED) {
+ /*
+ * Someone else has already logged error information for this
+ * command; we shouldn't add anything more.
+ */
- if (semiPtr != NULL) {
- *semiPtr = 0;
+ 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;
+ iPtr->errorLine = 1;
+ for (p = script; p != command; p++) {
+ if (*p == '\n') {
+ iPtr->errorLine++;
}
- if ((p[0] == '\\') && (p[1] == '\n')) {
- if (p+2 == lastChar) {
- return p+2;
- }
- continue;
- }
- 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;
+ }
+ for (i = 0; i < objectsUsed; i++) {
+ Tcl_DecrRefCount(objv[i]);
}
- p++;
- } else if (p == lastChar) {
- return p;
- } else {
- p++;
+ 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) {
+ Tcl_FreeParse(&parse);
+ }
+ 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;
- 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->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->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;
}
- p++;
- if (nested) {
- if (*p == ']') {
- return p;
+ tokenPtr->size = src - tokenPtr->start;
+ if (tokenPtr->size == 0) {
+ goto justADollarSign;
+ }
+ parsePtr->numTokens++;
+ if ((src != end) && (*src == '(')) {
+ /*
+ * 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->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:
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ return TCL_ERROR;
}
/*
@@ -738,7 +1755,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,120 +1773,347 @@ 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 */
- }
+ 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;
+ }
+
+ 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 (*src == '}') {
+ level--;
+ if (level == 0) {
+ break;
+ }
+ 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 {
- string++;
+ src += length;
}
- }
- if (string == name1) {
- if (termPtr != 0) {
- *termPtr = string;
+ } else if (src == end) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
}
- return "$";
+ parsePtr->term = string;
+ parsePtr->incomplete = 1;
+ goto error;
+ } else {
+ src++;
}
- name1End = string;
- if (*string == '(') {
- char *end;
+ }
- /*
- * Perform substitutions on the array element name, just as
- * is done for quotes.
- */
+ /*
+ * 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;
- 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;
+ error:
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- length = string-name1;
- if (length > 100) {
- length = 100;
- }
- sprintf(msg, "\n (parsing index for array \"%.*s\")",
- length, name1);
- Tcl_AddErrorInfo(interp, msg);
- result = NULL;
- name2 = pv.buffer;
- if (termPtr != 0) {
- *termPtr = end;
- }
- goto done;
- }
- Tcl_ResetResult(interp);
- string = end;
- name2 = 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;
+ }
+
+ 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->term = string;
+ parsePtr->incomplete = 1;
+ goto error;
}
- if (termPtr != 0) {
- *termPtr = string;
+ if (termPtr != NULL) {
+ *termPtr = (parsePtr->term + 1);
}
+ return TCL_OK;
- c = *name1End;
- *name1End = 0;
- result = Tcl_GetVar2(interp, name1, name2, TCL_LEAVE_ERR_MSG);
- *name1End = c;
+ error:
+ if (parsePtr->tokenPtr != parsePtr->staticTokens) {
+ ckfree((char *) parsePtr->tokenPtr);
+ parsePtr->tokenPtr = parsePtr->staticTokens;
+ }
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
- done:
- if ((name2 != NULL) && (pv.buffer != copyStorage)) {
- ckfree(pv.buffer);
+static int
+CommandComplete(script, length)
+ char *script; /* Script to check. */
+ int length; /* Number of bytes in script. */
+{
+ Tcl_Parse parse;
+ char *p, *end;
+
+ 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;
+ }
+ }
+ if (parse.incomplete) {
+ return 0;
}
- return result;
+ return 1;
}
/*
@@ -877,12 +2121,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 +2137,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 +2162,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/generic/tclParseExpr.c b/generic/tclParseExpr.c
new file mode 100644
index 0000000..306d5de
--- /dev/null
+++ b/generic/tclParseExpr.c
@@ -0,0 +1,1826 @@
+/*
+ * 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: tclParseExpr.c,v 1.2 1999/04/16 00:46:51 stanton Exp $
+ */
+
+#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->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->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);
+ }
+ return TCL_ERROR;
+ }
+ if (termPtr != src) {
+ /*
+ * src was the start of a valid integer.
+ */
+
+ 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);
+ }
+ 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);
+}
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 838626a..4f39c93 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.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: tclPipe.c,v 1.2 1998/09/14 18:40:01 stanton Exp $
+ * RCS: @(#) $Id: tclPipe.c,v 1.3 1999/04/16 00:46:51 stanton Exp $
*/
#include "tclInt.h"
@@ -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;
}
@@ -689,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: ",
@@ -765,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: ",
@@ -799,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;
}
@@ -851,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/generic/tclPkg.c b/generic/tclPkg.c
index 97a99e8..5cb1818 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPkg.c,v 1.3 1999/03/10 05:52:49 stanton Exp $
+ * RCS: @(#) $Id: tclPkg.c,v 1.4 1999/04/16 00:46:51 stanton Exp $
*/
#include "tclInt.h"
@@ -43,7 +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. */
+ ClientData clientData; /* Client data. */
} Package;
/*
@@ -70,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,
@@ -109,6 +109,9 @@ Tcl_PkgProvideEx(interp, name, version, 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 \"",
@@ -136,7 +139,7 @@ Tcl_PkgProvideEx(interp, name, version, clientData)
* 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
@@ -310,15 +313,13 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
if (clientDataPtr) {
*clientDataPtr = pkgPtr->clientData;
}
-
return pkgPtr->version;
}
result = ComparePkgVersions(pkgPtr->version, version, &satisfies);
if ((satisfies && !exact) || (result == 0)) {
- if (clientDataPtr) {
+ if (clientDataPtr) {
*clientDataPtr = pkgPtr->clientData;
}
-
return pkgPtr->version;
}
Tcl_AppendResult(interp, "version conflict for package \"",
@@ -446,7 +447,7 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
/*
*----------------------------------------------------------------------
*
- * Tcl_PackageCmd --
+ * Tcl_PackageObjCmd --
*
* This procedure is invoked to process the "package" Tcl command.
* See the user documentation for details on what it does.
@@ -462,254 +463,293 @@ Tcl_PkgPresentEx(interp, name, version, exact, clientDataPtr)
/* 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;
}
- 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_GetString(objv[3]);
+ if (CheckVersion(interp, argv3) != TCL_OK) {
+ return TCL_ERROR;
}
- ckfree((char *) pkgPtr);
- }
- } 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;
- }
- if (CheckVersion(interp, argv[3]) != TCL_OK) {
- return TCL_ERROR;
- }
- if (argc == 4) {
- hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv[2]);
- if (hPtr == NULL) {
+ 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);
+ }
+ 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;
+ }
+ }
+ if (objc == 4) {
return TCL_OK;
}
- pkgPtr = (Package *) Tcl_GetHashValue(hPtr);
- } else {
- pkgPtr = FindPackage(interp, argv[2]);
- }
- 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;
+ 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;
}
- Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
- break;
}
+ argv4 = Tcl_GetStringFromObj(objv[4], &length);
+ availPtr->script = ckalloc((unsigned) (length + 1));
+ strcpy(availPtr->script, argv4);
+ break;
}
- if (argc == 4) {
- return TCL_OK;
+ 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 (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;
+ 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 {
- availPtr->nextPtr = prevPtr->nextPtr;
- prevPtr->nextPtr = availPtr;
+ exact = 0;
}
- }
- 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));
+ 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;
}
- } else if ((c == 'p') && (strncmp(argv[1], "present", length) == 0)
- && (length >=3)) {
- if (argc < 3) {
- presentSyntax:
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " present ?-exact? package ?version?\"", (char *) NULL);
- return TCL_ERROR;
- }
- if ((argv[2][0] == '-') && (strcmp(argv[2], "-exact") == 0)) {
- exact = 1;
- } else {
- exact = 0;
+ 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;
+ }
+ argv3 = Tcl_GetString(objv[3]);
+ if (CheckVersion(interp, argv3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_PkgProvide(interp, argv2, argv3);
}
- version = NULL;
- if (argc == (4+exact)) {
- version = argv[3+exact];
- if (CheckVersion(interp, version) != 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;
+ }
+ } else if ((objc != 3) || exact) {
+ goto requireSyntax;
+ }
+ if (exact) {
+ argv3 = Tcl_GetString(objv[3]);
+ version = Tcl_PkgRequire(interp, argv3, version, exact);
+ } else {
+ version = Tcl_PkgRequire(interp, argv2, version, exact);
+ }
+ if (version == NULL) {
return TCL_ERROR;
}
- } else if ((argc != 3) || exact) {
- goto presentSyntax;
+ Tcl_SetResult(interp, version, TCL_VOLATILE);
+ break;
}
- version = Tcl_PkgPresent(interp, argv[2+exact], version, exact);
- if (version == NULL) {
- return TCL_ERROR;
+ 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;
}
- Tcl_SetResult(interp, version, TCL_VOLATILE);
- } else if ((c == 'p') && (strncmp(argv[1], "provide", length) == 0)
- && (length >=3)) {
- 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, ",
- "present, provide, require, unknown, vcompare, ",
- "versions, or vsatisfies", (char *) NULL);
- return TCL_ERROR;
}
return TCL_OK;
}
@@ -815,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.
@@ -832,11 +872,11 @@ CheckVersion(interp, string)
{
char *p = string;
- if (!isdigit(UCHAR(*p))) {
+ if (!isdigit(UCHAR(*p))) { /* INTL: digit */
goto error;
}
for (p++; *p != 0; p++) {
- if (!isdigit(UCHAR(*p)) && (*p != '.')) {
+ if (!isdigit(UCHAR(*p)) && (*p != '.')) { /* INTL: digit */
goto error;
}
}
diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h
index 9df194d..214020d 100644
--- a/generic/tclPlatDecls.h
+++ b/generic/tclPlatDecls.h
@@ -1,3 +1,16 @@
+/*
+ * tclPlatDecls.h --
+ *
+ * Declarations of platform specific Tcl APIs.
+ *
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * All rights reserved.
+ *
+ * RCS: @(#) $Id: tclPlatDecls.h,v 1.4 1999/04/16 00:46:51 stanton Exp $
+ */
+
+#ifndef _TCLPLATDECLS
+#define _TCLPLATDECLS
/* !BEGIN!: Do not edit below this line. */
@@ -5,6 +18,14 @@
* 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_((
@@ -42,6 +63,10 @@ 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 */
@@ -63,45 +88,59 @@ extern TclPlatStubs *tclPlatStubsPtr;
* 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(procPtr) \
- (tclPlatStubsPtr->tcl_MacSetEventProc)(procPtr) /* 0 */
+#define Tcl_MacSetEventProc \
+ (tclPlatStubsPtr->tcl_MacSetEventProc) /* 0 */
#endif
#ifndef Tcl_MacConvertTextResource
-#define Tcl_MacConvertTextResource(resource) \
- (tclPlatStubsPtr->tcl_MacConvertTextResource)(resource) /* 1 */
+#define Tcl_MacConvertTextResource \
+ (tclPlatStubsPtr->tcl_MacConvertTextResource) /* 1 */
#endif
#ifndef Tcl_MacEvalResource
-#define Tcl_MacEvalResource(interp, resourceName, resourceNumber, fileName) \
- (tclPlatStubsPtr->tcl_MacEvalResource)(interp, resourceName, resourceNumber, fileName) /* 2 */
+#define Tcl_MacEvalResource \
+ (tclPlatStubsPtr->tcl_MacEvalResource) /* 2 */
#endif
#ifndef Tcl_MacFindResource
-#define Tcl_MacFindResource(interp, resourceType, resourceName, resourceNumber, resFileRef, releaseIt) \
- (tclPlatStubsPtr->tcl_MacFindResource)(interp, resourceType, resourceName, resourceNumber, resFileRef, releaseIt) /* 3 */
+#define Tcl_MacFindResource \
+ (tclPlatStubsPtr->tcl_MacFindResource) /* 3 */
#endif
#ifndef Tcl_GetOSTypeFromObj
-#define Tcl_GetOSTypeFromObj(interp, objPtr, osTypePtr) \
- (tclPlatStubsPtr->tcl_GetOSTypeFromObj)(interp, objPtr, osTypePtr) /* 4 */
+#define Tcl_GetOSTypeFromObj \
+ (tclPlatStubsPtr->tcl_GetOSTypeFromObj) /* 4 */
#endif
#ifndef Tcl_SetOSTypeObj
-#define Tcl_SetOSTypeObj(objPtr, osType) \
- (tclPlatStubsPtr->tcl_SetOSTypeObj)(objPtr, osType) /* 5 */
+#define Tcl_SetOSTypeObj \
+ (tclPlatStubsPtr->tcl_SetOSTypeObj) /* 5 */
#endif
#ifndef Tcl_NewOSTypeObj
-#define Tcl_NewOSTypeObj(osType) \
- (tclPlatStubsPtr->tcl_NewOSTypeObj)(osType) /* 6 */
+#define Tcl_NewOSTypeObj \
+ (tclPlatStubsPtr->tcl_NewOSTypeObj) /* 6 */
#endif
#ifndef strncasecmp
-#define strncasecmp(s1, s2, n) \
- (tclPlatStubsPtr->strncasecmp)(s1, s2, n) /* 7 */
+#define strncasecmp \
+ (tclPlatStubsPtr->strncasecmp) /* 7 */
#endif
#ifndef strcasecmp
-#define strcasecmp(s1, s2) \
- (tclPlatStubsPtr->strcasecmp)(s1, s2) /* 8 */
+#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/generic/tclPlatStubs.c b/generic/tclPlatStubs.c
deleted file mode 100644
index 7901c5d..0000000
--- a/generic/tclPlatStubs.c
+++ /dev/null
@@ -1,116 +0,0 @@
-/*
- * tclPlatStubs.c --
- *
- * This file contains the wrapper functions for the platform independent
- * unsupported Tcl API.
- *
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * All rights reserved.
- *
- * RCS: @(#) $Id: tclPlatStubs.c,v 1.3 1999/03/10 05:52:49 stanton Exp $
- */
-
-#include "tcl.h"
-
-/*
- * 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 stub functions:
- */
-
-#ifdef MAC_TCL
-/* Slot 0 */
-void
-Tcl_MacSetEventProc(procPtr)
- Tcl_MacConvertEventPtr procPtr;
-{
- (tclPlatStubsPtr->tcl_MacSetEventProc)(procPtr);
-}
-
-/* Slot 1 */
-char *
-Tcl_MacConvertTextResource(resource)
- Handle resource;
-{
- return (tclPlatStubsPtr->tcl_MacConvertTextResource)(resource);
-}
-
-/* Slot 2 */
-int
-Tcl_MacEvalResource(interp, resourceName, resourceNumber, fileName)
- Tcl_Interp * interp;
- char * resourceName;
- int resourceNumber;
- char * fileName;
-{
- return (tclPlatStubsPtr->tcl_MacEvalResource)(interp, resourceName, resourceNumber, fileName);
-}
-
-/* Slot 3 */
-Handle
-Tcl_MacFindResource(interp, resourceType, resourceName, resourceNumber, resFileRef, releaseIt)
- Tcl_Interp * interp;
- long resourceType;
- char * resourceName;
- int resourceNumber;
- char * resFileRef;
- int * releaseIt;
-{
- return (tclPlatStubsPtr->tcl_MacFindResource)(interp, resourceType, resourceName, resourceNumber, resFileRef, releaseIt);
-}
-
-/* Slot 4 */
-int
-Tcl_GetOSTypeFromObj(interp, objPtr, osTypePtr)
- Tcl_Interp * interp;
- Tcl_Obj * objPtr;
- OSType * osTypePtr;
-{
- return (tclPlatStubsPtr->tcl_GetOSTypeFromObj)(interp, objPtr, osTypePtr);
-}
-
-/* Slot 5 */
-void
-Tcl_SetOSTypeObj(objPtr, osType)
- Tcl_Obj * objPtr;
- OSType osType;
-{
- (tclPlatStubsPtr->tcl_SetOSTypeObj)(objPtr, osType);
-}
-
-/* Slot 6 */
-Tcl_Obj *
-Tcl_NewOSTypeObj(osType)
- OSType osType;
-{
- return (tclPlatStubsPtr->tcl_NewOSTypeObj)(osType);
-}
-
-/* Slot 7 */
-int
-strncasecmp(s1, s2, n)
- CONST char * s1;
- CONST char * s2;
- size_t n;
-{
- return (tclPlatStubsPtr->strncasecmp)(s1, s2, n);
-}
-
-/* Slot 8 */
-int
-strcasecmp(s1, s2)
- CONST char * s1;
- CONST char * s2;
-{
- return (tclPlatStubsPtr->strcasecmp)(s1, s2);
-}
-
-#endif /* MAC_TCL */
-
-/* !END!: Do not edit above this line. */
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 99bdb75..5c7c486 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -10,13 +10,13 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPort.h,v 1.2 1998/09/14 18:40:01 stanton Exp $
+ * RCS: @(#) $Id: tclPort.h,v 1.3 1999/04/16 00:46:52 stanton Exp $
*/
#ifndef _TCLPORT
#define _TCLPORT
-#if defined(__WIN32__) || defined(_WIN32)
+#if defined(__WIN32__)
# include "../win/tclWinPort.h"
#else
# if defined(MAC_TCL)
diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c
index 84f2d1a..7e61d20 100644
--- a/generic/tclPosixStr.c
+++ b/generic/tclPosixStr.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclPosixStr.c,v 1.3 1999/02/02 22:27:16 stanton Exp $
+ * RCS: @(#) $Id: tclPosixStr.c,v 1.4 1999/04/16 00:46:52 stanton Exp $
*/
#include "tclInt.h"
@@ -336,7 +336,7 @@ Tcl_ErrnoId()
#ifdef ENXIO
case ENXIO: return "ENXIO";
#endif
-#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
#ifdef EPERM
@@ -783,7 +783,7 @@ Tcl_ErrnoMsg(err)
#ifdef ENXIO
case ENXIO: return "no such device or address";
#endif
-#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
+#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EPERM
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index ce20445..50dfb02 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -7,12 +7,12 @@
* 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.
*
- * RCS: @(#) $Id: tclPreserve.c,v 1.2 1998/09/14 18:40:02 stanton Exp $
+ * RCS: @(#) $Id: tclPreserve.c,v 1.3 1999/04/16 00:46:52 stanton Exp $
*/
#include "tclInt.h"
@@ -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/generic/tclProc.c b/generic/tclProc.c
index d9f5f58..3609d16 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -5,12 +5,12 @@
* 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.
*
- * RCS: @(#) $Id: tclProc.c,v 1.18 1999/03/10 05:52:49 stanton Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.19 1999/04/16 00:46:52 stanton Exp $
*/
#include "tclInt.h"
@@ -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 */
};
-
/*
*----------------------------------------------------------------------
@@ -82,9 +83,9 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
* current namespace.
*/
- fullName = Tcl_GetStringFromObj(objv[1], (int *) NULL);
+ fullName = TclGetString(objv[1]);
TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
- /*flags*/ 0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
+ 0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
if (nsPtr == NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
@@ -145,7 +146,6 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
@@ -452,7 +452,6 @@ procError:
}
return TCL_ERROR;
}
-
/*
*----------------------------------------------------------------------
@@ -464,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
@@ -506,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;
}
@@ -565,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) {
@@ -576,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;
@@ -602,14 +600,15 @@ Tcl_UplevelObjCmd(dummy, interp, objc, objv)
*/
if (objc == 1) {
- result = Tcl_EvalObj(interp, objv[0]);
+ result = Tcl_EvalObjEx(interp, objv[0], 0);
} else {
- Tcl_Obj *cmdObjPtr = Tcl_ConcatObj(objc, objv);
- result = Tcl_EvalObj(interp, cmdObjPtr);
- Tcl_DecrRefCount(cmdObjPtr); /* done with object */
+ 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);
}
@@ -628,12 +627,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.
@@ -768,11 +772,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);
/*
@@ -815,23 +817,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
@@ -845,7 +847,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);
@@ -857,7 +858,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);
@@ -903,7 +904,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
@@ -956,8 +957,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;
}
@@ -966,7 +966,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;
@@ -977,57 +977,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);
}
@@ -1088,11 +1069,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;
@@ -1100,7 +1081,7 @@ 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;
}
}
@@ -1188,7 +1169,59 @@ 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;
+ char msg[100 + TCL_INTEGER_SPACE];
+
+ if (returnCode == TCL_RETURN) {
+ returnCode = TclUpdateReturnInfo(iPtr);
+ } else if (returnCode == TCL_ERROR) {
+ sprintf(msg, "\n (procedure \"%.*s\" line %d)",
+ nameLen, procName, 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;
+}
/*
*----------------------------------------------------------------------
@@ -1339,7 +1372,7 @@ TclUpdateReturnInfo(iPtr)
TclCmdProcType
TclGetInterpProc()
{
- return TclProcInterpProc;
+ return (TclCmdProcType) TclProcInterpProc;
}
/*
@@ -1364,7 +1397,7 @@ TclGetInterpProc()
TclObjCmdProcType
TclGetObjInterpProc()
{
- return TclObjInterpProc;
+ return (TclObjCmdProcType) TclObjInterpProc;
}
/*
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
new file mode 100644
index 0000000..96d2aea
--- /dev/null
+++ b/generic/tclRegexp.c
@@ -0,0 +1,792 @@
+/*
+ * 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: tclRegexp.c,v 1.2 1999/04/16 00:46:52 stanton Exp $
+ */
+
+#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. ***
+ */
+
+/*
+ * Declarations for functions used only in this file.
+ */
+
+static void DupRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr));
+static void FreeRegexpInternalRep _ANSI_ARGS_((Tcl_Obj *regexpPtr));
+static int SetRegexpFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+static TclRegexp * CompileRegexp _ANSI_ARGS_((Tcl_Interp *interp,
+ char *pattern, int length, int flags));
+
+/*
+ * 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. */
+ char *string; /* String for which to produce
+ * compiled regular expression. */
+{
+ Interp *iPtr = (Interp *) interp;
+ int i, length;
+ TclRegexp *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;
+ }
+ return (Tcl_RegExp) iPtr->regexps[0];
+ }
+ }
+
+ /*
+ * No match in the cache. Compile the string and add it to the
+ * cache.
+ */
+
+ result = CompileRegexp(interp, string, length, REG_ADVANCED);
+ if (!result) {
+ return NULL;
+ }
+
+ /*
+ * We successfully compiled the expression, so add it to the cache.
+ */
+
+ if (iPtr->patterns[NUM_REGEXPS-1] != NULL) {
+ ckfree(iPtr->patterns[NUM_REGEXPS-1]);
+ TclReFree(&(iPtr->regexps[NUM_REGEXPS-1]->re));
+ 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 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 result, numChars;
+ Tcl_DString stringBuffer;
+ Tcl_UniChar *uniString;
+
+ TclRegexp *regexpPtr = (TclRegexp *) re;
+
+ /*
+ * Remember the UTF-8 string so Tcl_RegExpRange() can convert the
+ * matches from character to byte offsets.
+ */
+
+ regexpPtr->string = string;
+
+ Tcl_DStringInit(&stringBuffer);
+ uniString = Tcl_UtfToUniCharDString(string, -1, &stringBuffer);
+ numChars = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);
+
+ /*
+ * Perform the regexp match.
+ */
+
+ result = TclRegExpExecUniChar(interp, re, uniString, numChars, -1,
+ ((string > start) ? REG_NOTBOL : 0));
+
+ Tcl_DStringFree(&stringBuffer);
+
+ 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;
+
+ if ((size_t) index > regexpPtr->re.re_nsub) {
+ *startPtr = *endPtr = NULL;
+ } else if (regexpPtr->matches[index].rm_so < 0) {
+ *startPtr = *endPtr = NULL;
+ } else {
+ *startPtr = Tcl_UtfAtIndex(regexpPtr->string,
+ regexpPtr->matches[index].rm_so);
+ *endPtr = Tcl_UtfAtIndex(regexpPtr->string,
+ regexpPtr->matches[index].rm_eo);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclRegExpExecUniChar --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegExpExecUniChar(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 nm = regexpPtr->re.re_nsub + 1;
+
+ if (nmatches >= 0 && (size_t) nmatches < nm)
+ nm = (size_t) nmatches;
+
+ status = TclReExec(&regexpPtr->re, wString, (size_t) numChars,
+ (rm_detail_t *)NULL, 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.
+ *
+ * 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
+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. */
+ 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 ((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. */
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclRegExpMatchObj --
+ *
+ * See if a string matches a regular expression pattern 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:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclRegExpMatchObj(interp, string, patObj)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *string; /* String. */
+ Tcl_Obj *patObj; /* Regular expression to match against
+ * string. */
+{
+ Tcl_RegExp re;
+
+ re = Tcl_GetRegExpFromObj(interp, patObj, REG_ADVANCED);
+ if (re == NULL) {
+ return -1;
+ }
+ return Tcl_RegExpExec(interp, re, string, string);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ 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;
+ }
+
+ /*
+ * 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"},
+ {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;
+
+ TclReFree(&regexpRepPtr->re);
+ if (regexpRepPtr->matches) {
+ ckfree((char *) regexpRepPtr->matches);
+ }
+ ckfree((char *) regexpRepPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupRegexpInternalRep --
+ *
+ * It is way too hairy to copy a regular expression, so we punt
+ * and revert the object back to a vanilla string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the type back to string.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupRegexpInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ copyPtr->internalRep.longValue = (long)copyPtr->length;
+ copyPtr->typePtr = &tclStringType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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
+ *
+ * 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:
+ * Memory 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;
+
+ regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
+
+ /*
+ * 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));
+
+ return regexpPtr;
+}
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index eeda20d..7be13c1 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -1,18 +1,45 @@
-/*
- * Definitions etc. for regexp(3) routines.
+/*
+ * tclRegexp.h --
+ *
+ * This file contains definitions used internally by Henry
+ * Spencer's regular expression code.
+ *
+ * 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.
+ *
+ * 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.
+ *
+ * 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: tclRegexp.h,v 1.4 1998/09/14 18:40:02 stanton Exp $
+ * RCS: @(#) $Id: tclRegexp.h,v 1.5 1999/04/16 00:46:52 stanton Exp $
*/
-#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 +47,46 @@
#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.
*/
-#define NSUBEXP 20
+typedef struct TclRegexp {
+ int flags; /* Regexp compile flags. */
+ regex_t re; /* Compiled re, includes number of
+ * subexpressions. */
+ CONST char *string; /* Last string matched with this regexp
+ * (UTF-8), so Tcl_RegExpRange() can convert
+ * the matches from character indices to UTF-8
+ * byte offsets. */
+ 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. */
+} TclRegexp;
+
+/*
+ * Functions exported for use within the rest of Tcl.
+ */
-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 int TclRegAbout _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_RegExp re));
+EXTERN VOID TclRegXflags _ANSI_ARGS_((char *string, int length,
+ int *cflagsPtr, int *eflagsPtr));
+EXTERN int TclRegExpExecUniChar _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_RegExp re, CONST Tcl_UniChar *uniString,
+ int numChars, int nmatches, int flags));
+EXTERN int TclRegExpMatchObj _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, Tcl_Obj *patObj));
+EXTERN void TclRegExpRangeUniChar _ANSI_ARGS_((Tcl_RegExp re,
+ int index, int *startPtr, int *endPtr));
-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));
+/*
+ * Functions exported from the regexp package for the test package to use.
+ */
-# undef TCL_STORAGE_CLASS
-# define TCL_STORAGE_CLASS DLLIMPORT
+EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp *interp, char *msg,
+ int status));
-#endif /* REGEXP */
+#endif /* _TCLREGEXP */
diff --git a/generic/tclResult.c b/generic/tclResult.c
new file mode 100644
index 0000000..002437d
--- /dev/null
+++ b/generic/tclResult.c
@@ -0,0 +1,1025 @@
+/*
+ * 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: tclResult.c,v 1.2 1999/04/16 00:46:53 stanton Exp $
+ */
+
+#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. */
+{
+ Interp *iPtr = (Interp *) interp;
+ va_list tmpArgList;
+ char *string;
+ int newSpace;
+
+ /*
+ * 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.
+ */
+
+ tmpArgList = argList;
+ newSpace = 0;
+ while (1) {
+ string = va_arg(tmpArgList, char *);
+ if (string == NULL) {
+ break;
+ }
+ newSpace += strlen(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.
+ */
+
+ while (1) {
+ string = va_arg(argList, char *);
+ if (string == NULL) {
+ break;
+ }
+ strcpy(iPtr->appendResult + iPtr->appendUsed, string);
+ iPtr->appendUsed += strlen(string);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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/generic/tclScan.c b/generic/tclScan.c
new file mode 100644
index 0000000..92b192c
--- /dev/null
+++ b/generic/tclScan.c
@@ -0,0 +1,1032 @@
+/*
+ * 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: tclScan.c,v 1.2 1999/04/16 00:46:53 stanton Exp $
+ */
+
+#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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ Tcl_Interp *interp; /* Current interpreter. */
+ char *format; /* The format string. */
+ int numVars; /* The number of variables passed to the
+ * scan command. */
+{
+ int gotXpg, gotSequential, value, i, flags;
+ char *end;
+ Tcl_UniChar ch;
+ int *nassign = (int*)ckalloc(sizeof(int) * numVars);
+ int objIndex;
+
+ /*
+ * 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.
+ */
+
+ for (i = 0; i < numVars; i++) {
+ nassign[i] = 0;
+ }
+
+ 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) || (objIndex >= numVars)) {
+ goto badIndex;
+ }
+ 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) && 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)) {
+ nassign[objIndex]++;
+ objIndex++;
+ }
+ }
+
+ /*
+ * Verify that all of the variable were assigned exactly once.
+ */
+
+ 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 (nassign[i] == 0) {
+ Tcl_SetResult(interp, "variable is not assigend by any conversion specifiers", TCL_STATIC);
+ goto error;
+ }
+ }
+
+ 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:
+ ckfree((char *)nassign);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ 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, *objPtr;
+ 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) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate space for the result objects.
+ */
+
+ objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * numVars);
+ for (i = 0; i < numVars; 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 (!(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;
+
+ for (i = 0; i < numVars; 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]);
+ }
+ }
+ ckfree((char*) objs);
+ if (code == TCL_OK) {
+ if (underflow && (nconversions == 0)) {
+ result = -1;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+ }
+ return code;
+}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 409b983..c0261c7 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStringObj.c,v 1.3 1999/03/10 05:52:49 stanton Exp $
+ * RCS: @(#) $Id: tclStringObj.c,v 1.4 1999/04/16 00:46:53 stanton Exp $
*/
#include "tclInt.h"
@@ -74,9 +74,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 +88,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 +140,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 +165,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
@@ -224,7 +224,7 @@ Tcl_SetStringObj(objPtr, bytes, length)
Tcl_InvalidateStringRep(objPtr);
if (length < 0) {
- length = strlen(bytes);
+ length = (bytes? strlen(bytes) : 0);
}
TclInitStringRep(objPtr, bytes, length);
@@ -335,7 +335,7 @@ Tcl_AppendToObj(objPtr, bytes, length)
ConvertToStringType(objPtr);
}
if (length < 0) {
- length = strlen(bytes);
+ length = (bytes? strlen(bytes) : 0);
}
if (length == 0) {
return;
@@ -363,6 +363,35 @@ Tcl_AppendToObj(objPtr, bytes, length)
/*
*----------------------------------------------------------------------
*
+ * Tcl_AppendObjToObj --
+ *
+ * This procedure appends the string rep of one object to another.
+ *
+ * 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. */
+{
+ int length;
+ char *stringRep;
+
+ stringRep = Tcl_GetStringFromObj(appendObjPtr, &length);
+ Tcl_AppendToObj(objPtr, stringRep, length);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_AppendStringsToObjVA --
*
* This procedure appends one or more null-terminated strings
@@ -380,7 +409,7 @@ Tcl_AppendToObj(objPtr, bytes, length)
void
Tcl_AppendStringsToObjVA (objPtr, argList)
- register Tcl_Obj *objPtr; /* Points to the object to append to. */
+ Tcl_Obj *objPtr; /* Points to the object to append to. */
va_list argList; /* Variable argument list. */
{
va_list tmpArgList;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 306da5e..d11b0b3 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,12 +8,11 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.6 1999/03/11 00:19:23 stanton Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.7 1999/04/16 00:46:53 stanton Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
-#include "tclCompile.h"
/*
* Remove macros that will interfere with the definitions below.
@@ -48,7 +47,7 @@ TclStubs tclStubs = {
&tclStubHooks,
Tcl_PkgProvideEx, /* 0 */
Tcl_PkgRequireEx, /* 1 */
- panic, /* 2 */
+ Tcl_Panic, /* 2 */
Tcl_Alloc, /* 3 */
Tcl_Free, /* 4 */
Tcl_Realloc, /* 5 */
@@ -348,12 +347,97 @@ TclStubs tclStubs = {
Tcl_SetErrorCodeVA, /* 275 */
Tcl_VarEvalVA, /* 276 */
Tcl_WaitPid, /* 277 */
- panicVA, /* 278 */
+ Tcl_PanicVA, /* 278 */
Tcl_GetVersion, /* 279 */
+ Tcl_InitMemory, /* 280 */
+ NULL, /* 281 */
+ NULL, /* 282 */
+ NULL, /* 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 */
};
-TclStubs *tclStubsPtr = &tclStubs;
-
TclIntStubs tclIntStubs = {
TCL_STUB_MAGIC,
NULL,
@@ -361,7 +445,7 @@ TclIntStubs tclIntStubs = {
TclAccessDeleteProc, /* 1 */
TclAccessInsertProc, /* 2 */
TclAllocateFreeObjects, /* 3 */
- TclChdir, /* 4 */
+ NULL, /* 4 */
TclCleanupChildren, /* 5 */
TclCleanupCommand, /* 6 */
TclCopyAndCollapse, /* 7 */
@@ -372,7 +456,7 @@ TclIntStubs tclIntStubs = {
TclDeleteVars, /* 12 */
TclDoGlob, /* 13 */
TclDumpMemoryInfo, /* 14 */
- TclExpandParseValue, /* 15 */
+ NULL, /* 15 */
TclExprFloatError, /* 16 */
TclFileAttrsCmd, /* 17 */
TclFileCopyCmd, /* 18 */
@@ -383,11 +467,11 @@ TclIntStubs tclIntStubs = {
TclFindProc, /* 23 */
TclFormatInt, /* 24 */
TclFreePackageInfo, /* 25 */
- TclGetCwd, /* 26 */
+ NULL, /* 26 */
TclGetDate, /* 27 */
- TclGetDefaultStdChannel, /* 28 */
+ TclpGetDefaultStdChannel, /* 28 */
TclGetElementOfIndexedArray, /* 29 */
- TclGetEnv, /* 30 */
+ NULL, /* 30 */
TclGetExtension, /* 31 */
TclGetFrame, /* 32 */
TclGetInterpProc, /* 33 */
@@ -399,7 +483,7 @@ TclIntStubs tclIntStubs = {
TclGetObjInterpProc, /* 39 */
TclGetOpenMode, /* 40 */
TclGetOriginalCommand, /* 41 */
- TclGetUserHome, /* 42 */
+ TclpGetUserHome, /* 42 */
TclGlobalInvoke, /* 43 */
TclGuessPackageName, /* 44 */
TclHideUnsafeCommands, /* 45 */
@@ -413,10 +497,10 @@ TclIntStubs tclIntStubs = {
TclInvokeObjectCommand, /* 53 */
TclInvokeStringCommand, /* 54 */
TclIsProc, /* 55 */
- TclLoadFile, /* 56 */
- TclLooksLikeInt, /* 57 */
+ NULL, /* 56 */
+ NULL, /* 57 */
TclLookupVar, /* 58 */
- TclMatchFiles, /* 59 */
+ TclpMatchFiles, /* 59 */
TclNeedSpace, /* 60 */
TclNewProcBodyObj, /* 61 */
TclObjCommandComplete, /* 62 */
@@ -441,13 +525,13 @@ TclIntStubs tclIntStubs = {
TclpRealloc, /* 81 */
TclpRemoveDirectory, /* 82 */
TclpRenameFile, /* 83 */
- TclParseBraces, /* 84 */
- TclParseNestedCmd, /* 85 */
- TclParseQuotes, /* 86 */
- TclPlatformInit, /* 87 */
+ NULL, /* 84 */
+ NULL, /* 85 */
+ NULL, /* 86 */
+ NULL, /* 87 */
TclPrecTraceProc, /* 88 */
TclPreventAliasLoop, /* 89 */
- TclPrintByteCodeObj, /* 90 */
+ NULL, /* 90 */
TclProcCleanupProc, /* 91 */
TclProcCompileProc, /* 92 */
TclProcDeleteProc, /* 93 */
@@ -458,7 +542,7 @@ TclIntStubs tclIntStubs = {
TclServiceIdle, /* 98 */
TclSetElementOfIndexedArray, /* 99 */
TclSetIndexedScalar, /* 100 */
- TclSetPreInitScript, /* 101 */
+ NULL, /* 101 */
TclSetupEnv, /* 102 */
TclSockGetPort, /* 103 */
TclSockMinimumBuffers, /* 104 */
@@ -467,7 +551,7 @@ TclIntStubs tclIntStubs = {
TclStatInsertProc, /* 107 */
TclTeardownNamespace, /* 108 */
TclUpdateReturnInfo, /* 109 */
- TclWordEnd, /* 110 */
+ NULL, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
Tcl_AppendExportList, /* 112 */
Tcl_CreateNamespace, /* 113 */
@@ -489,14 +573,18 @@ TclIntStubs tclIntStubs = {
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
Tcl_SetNamespaceResolvers, /* 131 */
- TclHasSockets, /* 132 */
+ TclpHasSockets, /* 132 */
TclpGetDate, /* 133 */
- TclStrftime, /* 134 */
+ TclpStrftime, /* 134 */
TclpCheckStackSpace, /* 135 */
+ NULL, /* 136 */
+ TclpChdir, /* 137 */
+ TclGetEnv, /* 138 */
+ TclpLoadFile, /* 139 */
+ TclLooksLikeInt, /* 140 */
+ TclpGetCwd, /* 141 */
};
-TclIntStubs *tclIntStubsPtr = &tclIntStubs;
-
TclIntPlatStubs tclIntPlatStubs = {
TCL_STUB_MAGIC,
NULL,
@@ -506,10 +594,11 @@ TclIntPlatStubs tclIntPlatStubs = {
TclpCreateCommandChannel, /* 2 */
TclpCreatePipe, /* 3 */
TclpCreateProcess, /* 4 */
- TclpCreateTempFile, /* 5 */
+ NULL, /* 5 */
TclpMakeFile, /* 6 */
TclpOpenFile, /* 7 */
TclUnixWaitForFile, /* 8 */
+ TclpCreateTempFile, /* 9 */
#endif /* UNIX */
#ifdef __WIN32__
TclWinConvertError, /* 0 */
@@ -517,7 +606,7 @@ TclIntPlatStubs tclIntPlatStubs = {
TclWinGetServByName, /* 2 */
TclWinGetSockOpt, /* 3 */
TclWinGetTclInstance, /* 4 */
- TclWinLoadLibrary, /* 5 */
+ NULL, /* 5 */
TclWinNToHS, /* 6 */
TclWinSetSockOpt, /* 7 */
TclpGetPid, /* 8 */
@@ -528,18 +617,21 @@ TclIntPlatStubs tclIntPlatStubs = {
TclpCreateCommandChannel, /* 13 */
TclpCreatePipe, /* 14 */
TclpCreateProcess, /* 15 */
- TclpCreateTempFile, /* 16 */
- TclpGetTZName, /* 17 */
+ NULL, /* 16 */
+ NULL, /* 17 */
TclpMakeFile, /* 18 */
TclpOpenFile, /* 19 */
TclWinAddProcess, /* 20 */
TclpAsyncMark, /* 21 */
+ TclpCreateTempFile, /* 22 */
+ TclpGetTZName, /* 23 */
+ TclWinNoBackslash, /* 24 */
#endif /* __WIN32__ */
#ifdef MAC_TCL
TclpSysAlloc, /* 0 */
TclpSysFree, /* 1 */
TclpSysRealloc, /* 2 */
- TclPlatformExit, /* 3 */
+ TclpExit, /* 3 */
FSpGetDefaultDir, /* 4 */
FSpSetDefaultDir, /* 5 */
FSpFindFolder, /* 6 */
@@ -560,16 +652,18 @@ TclIntPlatStubs tclIntPlatStubs = {
TclMacUnRegisterResourceFork, /* 21 */
TclMacCreateEnv, /* 22 */
TclMacFOpenHack, /* 23 */
- TclMacReadlink, /* 24 */
+ NULL, /* 24 */
TclMacChmod, /* 25 */
#endif /* MAC_TCL */
};
-TclIntPlatStubs *tclIntPlatStubsPtr = &tclIntPlatStubs;
-
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 */
@@ -583,8 +677,6 @@ TclPlatStubs tclPlatStubs = {
#endif /* MAC_TCL */
};
-TclPlatStubs *tclPlatStubsPtr = &tclPlatStubs;
-
static TclStubHooks tclStubHooks = {
&tclPlatStubs,
&tclIntStubs,
diff --git a/generic/tclStubs.c b/generic/tclStubs.c
index a1f11fc..21ebe06 100644
--- a/generic/tclStubs.c
+++ b/generic/tclStubs.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubs.c,v 1.6 1999/03/11 02:49:34 stanton Exp $
+ * RCS: @(#) $Id: tclStubs.c,v 1.7 1999/04/16 00:46:53 stanton Exp $
*/
#include "tcl.h"
@@ -29,8 +29,15 @@
#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
@@ -69,14 +76,14 @@ Tcl_PkgRequireEx(interp, name, version, exact, clientDataPtr)
/* Slot 2 */
void
-panic TCL_VARARGS_DEF(char *,format)
+Tcl_Panic TCL_VARARGS_DEF(char *,format)
{
char * var;
va_list argList;
var = (char *) TCL_VARARGS_START(char *,format,argList);
- (tclStubsPtr->panicVA)(var, argList);
+ (tclStubsPtr->tcl_PanicVA)(var, argList);
va_end(argList);
}
@@ -328,7 +335,7 @@ Tcl_DbNewObj(file, line)
/* Slot 28 */
Tcl_Obj *
Tcl_DbNewStringObj(bytes, length, file, line)
- char * bytes;
+ CONST char * bytes;
int length;
char * file;
int line;
@@ -354,12 +361,12 @@ TclFreeObj(objPtr)
/* Slot 31 */
int
-Tcl_GetBoolean(interp, string, boolPtr)
+Tcl_GetBoolean(interp, str, boolPtr)
Tcl_Interp * interp;
- char * string;
+ char * str;
int * boolPtr;
{
- return (tclStubsPtr->tcl_GetBoolean)(interp, string, boolPtr);
+ return (tclStubsPtr->tcl_GetBoolean)(interp, str, boolPtr);
}
/* Slot 32 */
@@ -383,12 +390,12 @@ Tcl_GetByteArrayFromObj(objPtr, lengthPtr)
/* Slot 34 */
int
-Tcl_GetDouble(interp, string, doublePtr)
+Tcl_GetDouble(interp, str, doublePtr)
Tcl_Interp * interp;
- char * string;
+ char * str;
double * doublePtr;
{
- return (tclStubsPtr->tcl_GetDouble)(interp, string, doublePtr);
+ return (tclStubsPtr->tcl_GetDouble)(interp, str, doublePtr);
}
/* Slot 35 */
@@ -416,12 +423,12 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr)
/* Slot 37 */
int
-Tcl_GetInt(interp, string, intPtr)
+Tcl_GetInt(interp, str, intPtr)
Tcl_Interp * interp;
- char * string;
+ char * str;
int * intPtr;
{
- return (tclStubsPtr->tcl_GetInt)(interp, string, intPtr);
+ return (tclStubsPtr->tcl_GetInt)(interp, str, intPtr);
}
/* Slot 38 */
@@ -594,7 +601,7 @@ Tcl_NewObj()
/* Slot 56 */
Tcl_Obj *
Tcl_NewStringObj(bytes, length)
- char * bytes;
+ CONST char * bytes;
int length;
{
return (tclStubsPtr->tcl_NewStringObj)(bytes, length);
@@ -688,7 +695,7 @@ Tcl_SetStringObj(objPtr, bytes, length)
void
Tcl_AddErrorInfo(interp, message)
Tcl_Interp * interp;
- char * message;
+ CONST char * message;
{
(tclStubsPtr->tcl_AddErrorInfo)(interp, message);
}
@@ -697,7 +704,7 @@ Tcl_AddErrorInfo(interp, message)
void
Tcl_AddObjErrorInfo(interp, message, length)
Tcl_Interp * interp;
- char * message;
+ CONST char * message;
int length;
{
(tclStubsPtr->tcl_AddObjErrorInfo)(interp, message, length);
@@ -715,7 +722,7 @@ Tcl_AllowExceptions(interp)
void
Tcl_AppendElement(interp, string)
Tcl_Interp * interp;
- char * string;
+ CONST char * string;
{
(tclStubsPtr->tcl_AppendElement)(interp, string);
}
@@ -1173,12 +1180,12 @@ Tcl_DoWhenIdle(proc, clientData)
/* Slot 117 */
char *
-Tcl_DStringAppend(dsPtr, string, length)
+Tcl_DStringAppend(dsPtr, str, length)
Tcl_DString * dsPtr;
- CONST char * string;
+ CONST char * str;
int length;
{
- return (tclStubsPtr->tcl_DStringAppend)(dsPtr, string, length);
+ return (tclStubsPtr->tcl_DStringAppend)(dsPtr, str, length);
}
/* Slot 118 */
@@ -1328,12 +1335,12 @@ Tcl_ExposeCommand(interp, hiddenCmdToken, cmdName)
/* Slot 135 */
int
-Tcl_ExprBoolean(interp, string, ptr)
+Tcl_ExprBoolean(interp, str, ptr)
Tcl_Interp * interp;
- char * string;
+ char * str;
int * ptr;
{
- return (tclStubsPtr->tcl_ExprBoolean)(interp, string, ptr);
+ return (tclStubsPtr->tcl_ExprBoolean)(interp, str, ptr);
}
/* Slot 136 */
@@ -1348,12 +1355,12 @@ Tcl_ExprBooleanObj(interp, objPtr, ptr)
/* Slot 137 */
int
-Tcl_ExprDouble(interp, string, ptr)
+Tcl_ExprDouble(interp, str, ptr)
Tcl_Interp * interp;
- char * string;
+ char * str;
double * ptr;
{
- return (tclStubsPtr->tcl_ExprDouble)(interp, string, ptr);
+ return (tclStubsPtr->tcl_ExprDouble)(interp, str, ptr);
}
/* Slot 138 */
@@ -1368,12 +1375,12 @@ Tcl_ExprDoubleObj(interp, objPtr, ptr)
/* Slot 139 */
int
-Tcl_ExprLong(interp, string, ptr)
+Tcl_ExprLong(interp, str, ptr)
Tcl_Interp * interp;
- char * string;
+ char * str;
long * ptr;
{
- return (tclStubsPtr->tcl_ExprLong)(interp, string, ptr);
+ return (tclStubsPtr->tcl_ExprLong)(interp, str, ptr);
}
/* Slot 140 */
@@ -1415,7 +1422,7 @@ Tcl_Finalize()
/* Slot 144 */
void
Tcl_FindExecutable(argv0)
- char * argv0;
+ CONST char * argv0;
{
(tclStubsPtr->tcl_FindExecutable)(argv0);
}
@@ -1620,14 +1627,14 @@ Tcl_GetObjResult(interp)
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
/* Slot 167 */
int
-Tcl_GetOpenFile(interp, string, write, checkUsage, filePtr)
+Tcl_GetOpenFile(interp, str, write, checkUsage, filePtr)
Tcl_Interp * interp;
- char * string;
+ char * str;
int write;
int checkUsage;
ClientData * filePtr;
{
- return (tclStubsPtr->tcl_GetOpenFile)(interp, string, write, checkUsage, filePtr);
+ return (tclStubsPtr->tcl_GetOpenFile)(interp, str, write, checkUsage, filePtr);
}
#endif /* UNIX */
@@ -1791,7 +1798,7 @@ Tcl_IsSafe(interp)
char *
Tcl_JoinPath(argc, argv, resultPtr)
int argc;
- char ** argv;
+ CONST char ** argv;
Tcl_DString * resultPtr;
{
return (tclStubsPtr->tcl_JoinPath)(argc, argv, resultPtr);
@@ -2038,23 +2045,23 @@ Tcl_RegExpCompile(interp, string)
/* Slot 213 */
int
-Tcl_RegExpExec(interp, regexp, string, start)
+Tcl_RegExpExec(interp, regexp, str, start)
Tcl_Interp * interp;
Tcl_RegExp regexp;
- char * string;
- char * start;
+ CONST char * str;
+ CONST char * start;
{
- return (tclStubsPtr->tcl_RegExpExec)(interp, regexp, string, start);
+ return (tclStubsPtr->tcl_RegExpExec)(interp, regexp, str, start);
}
/* Slot 214 */
int
-Tcl_RegExpMatch(interp, string, pattern)
+Tcl_RegExpMatch(interp, str, pattern)
Tcl_Interp * interp;
- char * string;
+ char * str;
char * pattern;
{
- return (tclStubsPtr->tcl_RegExpMatch)(interp, string, pattern);
+ return (tclStubsPtr->tcl_RegExpMatch)(interp, str, pattern);
}
/* Slot 215 */
@@ -2086,21 +2093,21 @@ Tcl_ResetResult(interp)
/* Slot 218 */
int
-Tcl_ScanElement(string, flagPtr)
- CONST char * string;
+Tcl_ScanElement(str, flagPtr)
+ CONST char * str;
int * flagPtr;
{
- return (tclStubsPtr->tcl_ScanElement)(string, flagPtr);
+ return (tclStubsPtr->tcl_ScanElement)(str, flagPtr);
}
/* Slot 219 */
int
-Tcl_ScanCountedElement(string, length, flagPtr)
- CONST char * string;
+Tcl_ScanCountedElement(str, length, flagPtr)
+ CONST char * str;
int length;
int * flagPtr;
{
- return (tclStubsPtr->tcl_ScanCountedElement)(string, length, flagPtr);
+ return (tclStubsPtr->tcl_ScanCountedElement)(str, length, flagPtr);
}
/* Slot 220 */
@@ -2217,12 +2224,12 @@ Tcl_SetRecursionLimit(interp, depth)
/* Slot 232 */
void
-Tcl_SetResult(interp, string, freeProc)
+Tcl_SetResult(interp, str, freeProc)
Tcl_Interp * interp;
- char * string;
+ char * str;
Tcl_FreeProc * freeProc;
{
- (tclStubsPtr->tcl_SetResult)(interp, string, freeProc);
+ (tclStubsPtr->tcl_SetResult)(interp, str, freeProc);
}
/* Slot 233 */
@@ -2309,19 +2316,19 @@ Tcl_SourceRCFile(interp)
/* Slot 242 */
int
-Tcl_SplitList(interp, list, argcPtr, argvPtr)
+Tcl_SplitList(interp, listStr, argcPtr, argvPtr)
Tcl_Interp * interp;
- char * list;
+ CONST char * listStr;
int * argcPtr;
char *** argvPtr;
{
- return (tclStubsPtr->tcl_SplitList)(interp, list, argcPtr, argvPtr);
+ return (tclStubsPtr->tcl_SplitList)(interp, listStr, argcPtr, argvPtr);
}
/* Slot 243 */
void
Tcl_SplitPath(path, argcPtr, argvPtr)
- char * path;
+ CONST char * path;
int * argcPtr;
char *** argvPtr;
{
@@ -2341,11 +2348,11 @@ Tcl_StaticPackage(interp, pkgName, initProc, safeInitProc)
/* Slot 245 */
int
-Tcl_StringMatch(string, pattern)
- char * string;
- char * pattern;
+Tcl_StringMatch(str, pattern)
+ CONST char * str;
+ CONST char * pattern;
{
- return (tclStubsPtr->tcl_StringMatch)(string, pattern);
+ return (tclStubsPtr->tcl_StringMatch)(str, pattern);
}
/* Slot 246 */
@@ -2385,7 +2392,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
char *
Tcl_TranslateFileName(interp, name, bufferPtr)
Tcl_Interp * interp;
- char * name;
+ CONST char * name;
Tcl_DString * bufferPtr;
{
return (tclStubsPtr->tcl_TranslateFileName)(interp, name, bufferPtr);
@@ -2606,12 +2613,12 @@ Tcl_HashStats(tablePtr)
/* Slot 270 */
char *
-Tcl_ParseVar(interp, string, termPtr)
+Tcl_ParseVar(interp, str, termPtr)
Tcl_Interp * interp;
- char * string;
+ char * str;
char ** termPtr;
{
- return (tclStubsPtr->tcl_ParseVar)(interp, string, termPtr);
+ return (tclStubsPtr->tcl_ParseVar)(interp, str, termPtr);
}
/* Slot 271 */
@@ -2688,11 +2695,11 @@ Tcl_WaitPid(pid, statPtr, options)
/* Slot 278 */
void
-panicVA(format, argList)
+Tcl_PanicVA(format, argList)
char * format;
va_list argList;
{
- (tclStubsPtr->panicVA)(format, argList);
+ (tclStubsPtr->tcl_PanicVA)(format, argList);
}
/* Slot 279 */
@@ -2706,5 +2713,555 @@ Tcl_GetVersion(major, minor, patchLevel, 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/generic/tclTest.c b/generic/tclTest.c
index b31ed64..80b296a 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -8,24 +8,28 @@
*
* Copyright (c) 1993-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: tclTest.c,v 1.9 1999/03/10 05:52:50 stanton Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.10 1999/04/16 00:46:54 stanton Exp $
*/
#define TCL_TEST
#include "tclInt.h"
#include "tclPort.h"
+#include "tclRegexp.h"
+#include <locale.h>
/*
* Declare external functions used in Windows tests.
*/
#if defined(__WIN32__)
-extern TclPlatformType * TclWinGetPlatform _ANSI_ARGS_((void));
+extern TclPlatformType *TclWinGetPlatform(void);
+EXTERN void TclWinSetInterfaces(int);
#endif
/*
@@ -77,6 +81,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 +133,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 +151,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 +185,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 +218,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,8 +233,26 @@ 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 TestsetCmd _ANSI_ARGS_((ClientData dummy,
@@ -212,18 +281,15 @@ 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[]));
/*
- * External (platform specific) initialization routine, this declaration
- * explicitly does not use EXTERN since this code does not get compiled
+ * 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));
/*
*----------------------------------------------------------------------
@@ -236,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.
@@ -258,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,
@@ -289,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,
@@ -308,9 +386,23 @@ 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", TestsetCmd,
@@ -332,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,
@@ -351,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.
*/
@@ -386,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:
@@ -406,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) {
@@ -475,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);
@@ -677,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],
@@ -744,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);
@@ -958,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!");
@@ -1160,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) {
@@ -1208,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
@@ -1257,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));
@@ -1267,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));
@@ -1298,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);
@@ -1463,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);
@@ -1557,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) {
@@ -1646,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
@@ -1696,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;
@@ -1776,6 +2204,617 @@ 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 REGEXP_TEST define, which
+ * enables the -xflags option.
+ *
+ * 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, result, indices, stringLength, wLen, match, about;
+ int hasxflags, cflags, eflags;
+ Tcl_RegExp regExpr;
+ char *string;
+ Tcl_DString stringBuffer, valueBuffer;
+ Tcl_UniChar *wStart;
+# define REGEXP_TEST /* yes */
+ static char *options[] = {
+ "-indices", "-nocase", "-about", "-expanded",
+ "-line", "-linestop", "-lineanchor",
+#ifdef REGEXP_TEST
+ "-xflags",
+#endif
+ "--", (char *) NULL
+ };
+ enum options {
+ REGEXP_INDICES, REGEXP_NOCASE, REGEXP_ABOUT, REGEXP_EXPANDED,
+ REGEXP_MULTI, REGEXP_NOCROSS, REGEXP_NEWL,
+#ifdef REGEXP_TEST
+ REGEXP_XFLAGS,
+#endif
+ REGEXP_LAST
+ };
+#ifndef REGEXP_TEST
+# define REGEXP_XFLAGS -1 /* impossible value */
+# define TestregexpXflags(a,b,c,d) /* do nothing */
+#endif
+
+ 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;
+ }
+
+ if (about) {
+ if (TclRegAbout(interp, regExpr) < 0) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ result = TCL_OK;
+ string = Tcl_GetStringFromObj(objv[1], &stringLength);
+
+ Tcl_DStringInit(&valueBuffer);
+
+ Tcl_DStringInit(&stringBuffer);
+ wStart = Tcl_UtfToUniCharDString(string, stringLength, &stringBuffer);
+ wLen = Tcl_DStringLength(&stringBuffer) / sizeof(Tcl_UniChar);
+
+ match = TclRegExpExecUniChar(interp, regExpr, wStart, wLen, objc-2, eflags);
+ if (match < 0) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (match == 0) {
+ /*
+ * Set the interpreter's object result to an integer object w/ value 0.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ goto done;
+ }
+
+ /*
+ * If additional variable names have been specified, return
+ * index information in those variables.
+ */
+
+ objc -= 2;
+ objv += 2;
+
+ for (i = 0; i < objc; i++) {
+ char *varName, *value;
+ int start, end;
+
+ varName = Tcl_GetString(objv[i]);
+
+ TclRegExpRangeUniChar(regExpr, i, &start, &end);
+ if (start < 0) {
+ if (indices) {
+ value = Tcl_SetVar(interp, varName, "-1 -1", 0);
+ } else {
+ value = Tcl_SetVar(interp, varName, "", 0);
+ }
+ } else {
+ if (indices) {
+ char info[TCL_INTEGER_SPACE * 2];
+
+ sprintf(info, "%d %d", start, end - 1);
+ value = Tcl_SetVar(interp, varName, info, 0);
+ } else {
+ value = Tcl_UniCharToUtfDString(wStart + start, end - start,
+ &valueBuffer);
+ value = Tcl_SetVar(interp, varName, value, 0);
+ Tcl_DStringSetLength(&valueBuffer, 0);
+ }
+ }
+ if (value == NULL) {
+ Tcl_AppendResult(interp, "couldn't set variable \"",
+ varName, "\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /*
+ * Set the interpreter's object result to an integer object w/ value 1.
+ */
+
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+
+ done:
+ Tcl_DStringFree(&stringBuffer);
+ Tcl_DStringFree(&valueBuffer);
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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 '+': {
+ cflags |= REG_FAKEEC;
+ 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 '%': {
+ eflags |= REG_SMALL;
+ break;
+ }
+ }
+ }
+
+ *cflagsPtr = cflags;
+ *eflagsPtr = eflags;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestsetassocdataCmd --
*
* This procedure implements the "testsetassocdata" command. It is used
@@ -2070,46 +3109,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".
@@ -2189,7 +3188,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,
@@ -2224,7 +3223,7 @@ TestfeventCmd(clientData, interp, argc, argv)
/*
*----------------------------------------------------------------------
*
- * TestPanicCmd --
+ * TestpanicCmd --
*
* Calls the panic routine.
*
@@ -2238,7 +3237,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. */
@@ -2420,9 +3419,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) {
@@ -2495,7 +3494,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");
@@ -2551,12 +3550,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);
@@ -2728,8 +3727,7 @@ TestsetCmd(data, interp, argc, argv)
if (argc == 2) {
Tcl_SetResult(interp, "before get", TCL_STATIC);
- value = Tcl_GetVar2(interp, argv[1], (char *) NULL,
- TCL_PARSE_PART1|flags);
+ value = Tcl_GetVar2(interp, argv[1], (char *) NULL, flags);
if (value == NULL) {
return TCL_ERROR;
}
@@ -2737,8 +3735,7 @@ TestsetCmd(data, interp, argc, argv)
return TCL_OK;
} else if (argc == 3) {
Tcl_SetResult(interp, "before set", TCL_STATIC);
- value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2],
- TCL_PARSE_PART1|flags);
+ value = Tcl_SetVar2(interp, argv[1], (char *) NULL, argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
}
@@ -2754,6 +3751,138 @@ TestsetCmd(data, 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
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 3f7f349..d604c5b 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -6,12 +6,12 @@
* 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.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTestObj.c,v 1.2 1998/09/14 18:40:02 stanton Exp $
+ * RCS: @(#) $Id: tclTestObj.c,v 1.3 1999/04/16 00:46:54 stanton Exp $
*/
#include "tclInt.h"
@@ -68,7 +68,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 +128,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 +137,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 +192,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 +223,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 +232,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 +246,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 +279,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 +289,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 +362,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 +394,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 +431,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 +484,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 +494,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 +528,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 +542,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 +583,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 +600,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 +654,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 +689,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 +696,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 +719,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 +741,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 +768,32 @@ 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, "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;
}
@@ -815,7 +816,7 @@ TestobjCmd(clientData, interp, objc, objv)
} 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",
(char *) NULL);
@@ -850,10 +851,10 @@ TeststringobjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
int varIndex, option, i, length;
-#define MAX_STRINGS 10
+#define MAX_STRINGS 11
char *index, *string, *strings[MAX_STRINGS+1];
static char *options[] = {
- "append", "appendstrings", "get", "length", "length2",
+ "append", "appendstrings", "get", "get2", "length", "length2",
"set", "set2", "setlength", (char *) NULL
};
@@ -863,7 +864,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 +893,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,9 +914,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]);
+ }
+ for ( ; i < 12 + 3; i++) {
+ strings[i - 3] = NULL;
}
- strings[objc-3] = NULL;
Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
strings[2], strings[3], strings[4], strings[5],
strings[6], strings[7], strings[8], strings[9],
@@ -931,21 +934,31 @@ 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);
break;
- case 5: /* set */
+ case 6: /* set */
if (objc != 4) {
goto wrongNumArgs;
}
@@ -968,13 +981,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;
}
@@ -1086,7 +1099,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/generic/tclThread.c b/generic/tclThread.c
new file mode 100644
index 0000000..2dcd832
--- /dev/null
+++ b/generic/tclThread.c
@@ -0,0 +1,563 @@
+/*
+ * 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: tclThread.c,v 1.2 1999/04/16 00:46:54 stanton Exp $
+ */
+
+#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));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeMutex
+ *
+ * Finalize a single mutex and remove it from the
+ * list of remembered objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Remove the mutex from the list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclFinalizeMutex(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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeCondition
+ *
+ * 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
+TclFinalizeCondition(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
+ }
+ TclpMasterUnlock();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFinalizeSyncronization --
+ *
+ * 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/generic/tclThreadTest.c b/generic/tclThreadTest.c
new file mode 100644
index 0000000..0acba19
--- /dev/null
+++ b/generic/tclThreadTest.c
@@ -0,0 +1,898 @@
+/*
+ * 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: tclThreadTest.c,v 1.2 1999/04/16 00:46:54 stanton Exp $
+ */
+
+#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
+
+#ifdef MAC_TCL
+static pascal void *NewThread _ANSI_ARGS_((ClientData clientData));
+#else
+static void NewThread _ANSI_ARGS_((ClientData clientData));
+#endif
+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 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_NewIntObj((int)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: {
+ int 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_GetIntFromObj(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*)ckalloc( strlen(script) + 1 );
+ strcpy(ctrl.script, script);
+ ctrl.condWait = NULL;
+ ctrl.flags = 0;
+
+ Tcl_MutexLock(&threadMutex);
+ if (TclpThreadCreate(&id, NewThread, (ClientData) &ctrl) != 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);
+ TclFinalizeCondition(&ctrl.condWait);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj((int)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.
+ *
+ *------------------------------------------------------------------------
+ */
+#ifdef MAC_TCL
+static pascal void *
+#else
+static void
+#endif
+NewThread(clientData)
+ ClientData clientData;
+{
+ ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadCtrl ctrl;
+ int result;
+
+ ctrl = *ctrlPtr;
+
+ /*
+ * 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);
+ Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
+
+ /*
+ * 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, ctrl.script);
+ if (result != TCL_OK) {
+ ThreadErrorProc(tsdPtr->interp);
+ }
+
+ /*
+ * Clean up.
+ */
+
+ ListRemove(tsdPtr);
+ ckfree((char*)ctrl.script);
+ Tcl_Release((ClientData) tsdPtr->interp);
+ Tcl_DeleteInterp(tsdPtr->interp);
+ Tcl_ExitThread(result);
+#ifdef MAC_TCL
+ return NULL;
+#endif
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * 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[10];
+ 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_NewIntObj((int)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) {
+ 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_MutexUnlock(&threadMutex);
+ Tcl_ThreadAlert(threadId);
+
+ if (!wait) {
+ return TCL_OK;
+ }
+
+ /*
+ * Block on the results and then get them.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_MutexLock(&threadMutex);
+ 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);
+ TclFinalizeCondition(&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);
+ code = Tcl_GlobalEval(interp, 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;
+}
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * 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(dummy)
+ ClientData dummy;
+{
+ ThreadEventResult *resultPtr, *nextPtr;
+ Tcl_ThreadId self = Tcl_GetCurrentThread();
+
+ Tcl_MutexLock(&threadMutex);
+ 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/generic/tclTimer.c b/generic/tclTimer.c
index 0137853..3397cb7 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -9,19 +9,13 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTimer.c,v 1.2 1998/09/14 18:40:02 stanton Exp $
+ * RCS: @(#) $Id: tclTimer.c,v 1.3 1999/04/16 00:46:54 stanton Exp $
*/
#include "tclInt.h"
#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/generic/tclUniData.c b/generic/tclUniData.c
new file mode 100644
index 0000000..976a914
--- /dev/null
+++ b/generic/tclUniData.c
@@ -0,0 +1,621 @@
+/*
+ * 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: tclUniData.c,v 1.2 1999/04/16 00:46:55 stanton Exp $
+ */
+
+/*
+ * 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 6
+
+/*
+ * 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 char pageMap[] = {
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
+ 20, 21, 22, 23, 24, 25, 26, 27, 28, 28, 28, 28, 28, 28, 28, 28, 29,
+ 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46,
+ 28, 28, 47, 48, 49, 50, 51, 52, 53, 28, 28, 28, 54, 55, 56, 57, 58,
+ 59, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 60, 60,
+ 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 75, 75,
+ 76, 77, 78, 28, 28, 79, 80, 81, 82, 83, 83, 84, 85, 86, 85, 28, 28,
+ 87, 88, 89, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 90, 91, 92, 93, 94, 56, 95, 28, 96, 97, 98, 99, 83, 100, 83,
+ 101, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 102, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 28, 28, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56, 56,
+ 56, 56, 56, 56, 56, 56, 56, 56, 56, 103, 28, 104, 104, 104, 104, 104,
+ 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104,
+ 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 56, 56, 56, 56, 106, 28, 28, 28, 107, 108, 109, 110, 56, 56, 56,
+ 56, 111, 112, 113, 114, 115, 116, 56, 117, 118, 119, 120, 121
+};
+
+/*
+ * 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 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, 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, 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, 38, 39, 15, 20, 21, 38, 20, 21, 40, 40, 20, 21, 20, 21,
+ 41, 20, 21, 15, 39, 20, 21, 39, 39, 39, 39, 39, 39, 42, 43, 44, 42,
+ 43, 44, 42, 43, 44, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 45, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 15, 42, 43, 44, 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, 46, 47, 15, 48, 48, 15, 49, 15, 50, 15, 15, 15, 15,
+ 48, 15, 15, 51, 15, 15, 15, 15, 52, 53, 15, 15, 15, 15, 15, 53, 15,
+ 15, 54, 15, 15, 55, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
+ 15, 56, 15, 15, 15, 15, 56, 15, 57, 57, 15, 15, 15, 15, 15, 15, 58,
+ 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, 59, 59, 59, 59, 59, 59, 59,
+ 59, 59, 11, 11, 59, 59, 59, 59, 59, 59, 59, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 11, 11, 11, 11, 59, 59, 11, 11, 11, 11, 11, 11, 11,
+ 11, 11, 11, 11, 11, 11, 0, 59, 59, 59, 59, 59, 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, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,
+ 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, 60, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 3, 3, 0, 0, 0, 0, 59, 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, 37, 37, 37, 72, 73, 0, 0, 0, 37, 0, 37, 0, 37,
+ 0, 37, 0, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21, 74,
+ 75, 45, 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 76, 76, 76, 76,
+ 76, 76, 76, 76, 76, 76, 76, 76, 0, 76, 76, 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, 75, 75, 75, 75, 75, 75, 75, 75, 75,
+ 75, 75, 75, 0, 75, 75, 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, 14, 60, 60, 60, 60, 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,
+ 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, 39, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77,
+ 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 0, 0, 59, 3, 3,
+ 3, 3, 3, 3, 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, 15, 0, 3, 0, 0, 0, 0, 0, 0, 0, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 0,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,
+ 60, 60, 60, 60, 60, 60, 0, 60, 60, 60, 3, 60, 3, 60, 60, 3, 60, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 0, 0, 0, 0, 0, 39, 39, 39, 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, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0,
+ 0, 0, 0, 0, 59, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 60, 60, 60,
+ 60, 60, 60, 60, 60, 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, 60, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 39, 39,
+ 39, 39, 39, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 0, 39, 39, 39, 39, 3, 39, 60, 60, 60, 60, 60, 60, 60, 79, 79,
+ 60, 60, 60, 60, 60, 60, 59, 59, 60, 60, 14, 60, 60, 60, 60, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 60, 60, 80, 0, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 60, 39,
+ 80, 80, 80, 60, 60, 60, 60, 60, 60, 60, 60, 80, 80, 80, 80, 60, 0,
+ 0, 14, 60, 60, 60, 60, 0, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 60, 60, 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, 60, 80, 80, 0, 39, 39, 39, 39, 39, 39,
+ 39, 39, 0, 0, 39, 39, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 39,
+ 39, 39, 39, 0, 39, 0, 0, 0, 39, 39, 39, 39, 0, 0, 60, 0, 80, 80, 80,
+ 60, 60, 60, 60, 0, 0, 80, 80, 0, 0, 80, 80, 60, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 80, 0, 0, 0, 0, 39, 39, 0, 39, 39, 39, 60, 60, 0, 0, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 9, 39, 39, 4, 4, 17, 17, 17, 17, 17, 17, 14, 0, 0,
+ 0, 0, 0, 0, 0, 60, 0, 0, 39, 39, 39, 39, 39, 39, 0, 0, 0, 0, 39, 39,
+ 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 0,
+ 39, 39, 0, 39, 39, 0, 0, 60, 0, 80, 80, 80, 60, 60, 0, 0, 0, 0, 60,
+ 60, 0, 0, 60, 60, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 39, 39,
+ 39, 0, 39, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 60, 60,
+ 39, 39, 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 60, 60, 80, 0, 39,
+ 39, 39, 39, 39, 39, 39, 0, 39, 0, 39, 39, 39, 0, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 0, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 0, 39, 39, 39, 39, 39, 0,
+ 0, 60, 39, 80, 80, 80, 60, 60, 60, 60, 60, 0, 60, 60, 80, 0, 80, 80,
+ 60, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 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, 0, 60, 80, 80, 0, 39, 39, 39, 39, 39, 39, 39, 39,
+ 0, 0, 39, 39, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 39, 39, 39,
+ 39, 0, 39, 39, 0, 0, 39, 39, 39, 39, 0, 0, 60, 39, 80, 60, 80, 60,
+ 60, 60, 0, 0, 0, 80, 80, 0, 0, 80, 80, 60, 0, 0, 0, 0, 0, 0, 0, 0,
+ 60, 80, 0, 0, 0, 0, 39, 39, 0, 39, 39, 39, 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, 60, 80, 0, 39, 39, 39, 39, 39, 39, 0, 0, 0, 39, 39, 39, 0, 39,
+ 39, 39, 39, 0, 0, 0, 39, 39, 0, 39, 0, 39, 39, 0, 0, 0, 39, 39, 0,
+ 0, 0, 39, 39, 39, 0, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39,
+ 39, 0, 0, 0, 0, 80, 80, 60, 80, 80, 0, 0, 0, 80, 80, 80, 0, 80, 80,
+ 80, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 80, 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, 80, 80, 80, 0, 39, 39, 39, 39, 39, 39, 39,
+ 39, 0, 39, 39, 39, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 0, 39, 39, 39, 39, 39, 0, 0, 0, 0, 60, 60, 60,
+ 80, 80, 80, 80, 0, 60, 60, 60, 0, 60, 60, 60, 60, 0, 0, 0, 0, 0, 0,
+ 0, 60, 60, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 39, 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, 80, 80, 0, 39, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 0,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 0, 39, 39, 39, 39, 39, 0, 0, 0, 0, 80, 60, 80, 80, 80, 80, 80, 0, 60,
+ 80, 80, 0, 80, 80, 60, 60, 0, 0, 0, 0, 0, 0, 0, 80, 80, 0, 0, 0, 0,
+ 0, 0, 0, 39, 0, 39, 39, 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, 80, 80, 0, 39, 39,
+ 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 0, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0,
+ 0, 0, 0, 80, 80, 80, 60, 60, 60, 0, 0, 80, 80, 80, 0, 80, 80, 80, 60,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 80, 0, 0, 0, 0, 0, 0, 0, 0, 39, 39, 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, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 3,
+ 39, 60, 39, 39, 60, 60, 60, 60, 60, 60, 60, 0, 0, 0, 0, 4, 39, 39,
+ 39, 39, 39, 39, 59, 60, 60, 60, 60, 60, 60, 60, 60, 14, 9, 9, 9, 9,
+ 9, 9, 9, 9, 9, 9, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39,
+ 39, 0, 39, 0, 0, 39, 39, 0, 39, 0, 0, 39, 0, 0, 0, 0, 0, 0, 39, 39,
+ 39, 39, 0, 39, 39, 39, 39, 39, 39, 39, 0, 39, 39, 39, 0, 39, 0, 39,
+ 0, 0, 39, 39, 0, 39, 39, 3, 39, 60, 39, 39, 60, 60, 60, 60, 60, 60,
+ 0, 60, 60, 39, 0, 0, 39, 39, 39, 39, 39, 0, 59, 0, 60, 60, 60, 60,
+ 60, 60, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 39, 39, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 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, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 60, 60, 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, 60, 14, 60, 14, 60, 5, 6, 5, 6, 5, 6, 39, 39, 39, 39, 39, 39, 39,
+ 39, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 0, 0, 0, 0, 0, 0, 0, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60,
+ 60, 60, 60, 80, 60, 60, 60, 60, 60, 3, 60, 60, 14, 14, 14, 14, 0, 0,
+ 0, 0, 60, 60, 60, 60, 60, 60, 0, 60, 0, 60, 60, 60, 60, 60, 60, 60,
+ 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 0, 0, 0, 60,
+ 60, 60, 60, 60, 60, 60, 0, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77,
+ 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77, 77,
+ 77, 77, 77, 77, 77, 77, 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, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 0, 0, 0,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 0, 0, 0, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 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, 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, 20, 21, 20, 21, 20, 21, 20, 21, 20, 21,
+ 20, 21, 20, 21, 20, 21, 15, 15, 15, 15, 15, 81, 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, 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, 20, 21, 20, 21, 20, 21, 20, 21, 20,
+ 21, 20, 21, 0, 0, 0, 0, 0, 0, 82, 82, 82, 82, 82, 82, 82, 82, 83, 83,
+ 83, 83, 83, 83, 83, 83, 82, 82, 82, 82, 82, 82, 0, 0, 83, 83, 83, 83,
+ 83, 83, 0, 0, 82, 82, 82, 82, 82, 82, 82, 82, 83, 83, 83, 83, 83, 83,
+ 83, 83, 82, 82, 82, 82, 82, 82, 82, 82, 83, 83, 83, 83, 83, 83, 83,
+ 83, 82, 82, 82, 82, 82, 82, 0, 0, 83, 83, 83, 83, 83, 83, 0, 0, 15,
+ 82, 15, 82, 15, 82, 15, 82, 0, 83, 0, 83, 0, 83, 0, 83, 82, 82, 82,
+ 82, 82, 82, 82, 82, 83, 83, 83, 83, 83, 83, 83, 83, 84, 84, 85, 85,
+ 85, 85, 86, 86, 87, 87, 88, 88, 89, 89, 0, 0, 82, 82, 82, 82, 82, 82,
+ 82, 82, 83, 83, 83, 83, 83, 83, 83, 83, 82, 82, 82, 82, 82, 82, 82,
+ 82, 83, 83, 83, 83, 83, 83, 83, 83, 82, 82, 82, 82, 82, 82, 82, 82,
+ 83, 83, 83, 83, 83, 83, 83, 83, 82, 82, 15, 90, 15, 0, 15, 15, 83,
+ 83, 91, 91, 92, 11, 37, 11, 11, 11, 15, 90, 15, 0, 15, 15, 93, 93,
+ 93, 93, 92, 11, 11, 11, 82, 82, 15, 15, 0, 0, 15, 15, 83, 83, 94, 94,
+ 0, 11, 11, 11, 82, 82, 15, 15, 15, 95, 15, 15, 83, 83, 96, 96, 97,
+ 11, 11, 11, 0, 0, 15, 90, 15, 0, 15, 15, 98, 98, 99, 99, 92, 11, 11,
+ 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 100, 100, 100, 100, 8, 8, 8,
+ 8, 8, 8, 3, 3, 16, 18, 5, 16, 16, 18, 5, 16, 3, 3, 3, 3, 3, 3, 3, 3,
+ 101, 102, 100, 100, 100, 100, 100, 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, 100, 100, 100, 100, 100, 100, 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, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 60, 79, 79, 79,
+ 79, 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, 0, 0, 0, 0, 14, 14, 37, 14, 14, 14, 14, 37, 14, 14,
+ 15, 37, 37, 37, 15, 15, 37, 37, 37, 15, 14, 37, 14, 14, 37, 37, 37,
+ 37, 37, 37, 14, 14, 14, 14, 14, 14, 37, 14, 37, 14, 37, 14, 37, 37,
+ 37, 37, 15, 15, 37, 37, 14, 37, 15, 39, 39, 39, 39, 0, 0, 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, 103, 103, 103, 103,
+ 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 104, 104,
+ 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104, 104,
+ 105, 105, 105, 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, 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, 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, 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, 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, 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, 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, 106, 106, 106,
+ 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106, 106,
+ 106, 106, 106, 106, 106, 106, 106, 106, 106, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107, 107,
+ 107, 107, 107, 107, 107, 107, 107, 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, 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, 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, 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, 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, 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, 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, 59, 3, 105, 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, 105, 105, 105, 105, 105, 105, 105, 105,
+ 105, 60, 60, 60, 60, 60, 60, 8, 59, 59, 59, 59, 59, 14, 14, 0, 0, 0,
+ 0, 0, 0, 0, 14, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 0, 0, 0, 0, 60, 60, 59, 59, 59, 59, 0, 0, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 3, 59, 59, 59, 0, 0, 0, 0, 0, 0, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0,
+ 0, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 14,
+ 14, 17, 17, 17, 17, 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, 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, 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, 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, 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, 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, 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, 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, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 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, 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, 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, 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, 109,
+ 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 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, 60, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 7, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 0, 39, 39, 39, 39, 39, 0, 39, 0, 39, 39, 0, 39,
+ 39, 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 60, 60, 60, 60, 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, 39, 39, 39, 0, 39,
+ 0, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 0, 0, 100, 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, 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, 0, 0, 3, 5, 6, 3, 3, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 59, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 59,
+ 59, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39,
+ 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 39, 0, 0, 0,
+ 39, 39, 39, 39, 39, 39, 0, 0, 39, 39, 39, 39, 39, 39, 0, 0, 39, 39,
+ 39, 39, 39, 39, 0, 0, 39, 39, 39, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0,
+ 7, 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, 1, 914358337, 5, 910164033, 918552641, 8388705, 4194499,
+ 8388770, 331350146, 880803970, 864026754, 859832450, 847249538,
+ 851443842, 868221058, 876609666, 884998274, 893386882, 897581186,
+ 914358402, 910164098, 918552706, 4, 6, 159383617, 155189313, 268435521,
+ 264241217, 159383682, 155189378, 130023554, 268435586, 264241282,
+ 260046978, 239075458, 197132418, 226492546, 360710274, 335544450,
+ 335544385, 201326657, 201326722, 7, 8, 247464066, -33554302, -33554367,
+ -310378366, -360710014, -419430270, -536870782, -469761918, -528482174,
+ -37748606, -310378431, -37748671, -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[(int)groupMap[(int)((pageMap[(((int)(ch)) & 0xffff) >> OFFSET_BITS] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1)))]])
+
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
new file mode 100644
index 0000000..89c6b60
--- /dev/null
+++ b/generic/tclUtf.c
@@ -0,0 +1,1287 @@
+/*
+ * 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: tclUtf.c,v 1.2 1999/04/16 00:46:55 stanton Exp $
+ */
+
+#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)
+
+/*
+ * 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
+};
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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:
+ if (isdigit(UCHAR(*p))) { /* INTL: digit */
+ result = (unsigned char)(*p - '0');
+ p++;
+ if (!isdigit(UCHAR(*p))) { /* INTL: digit */
+ break;
+ }
+ count = 3;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ p++;
+ if (!isdigit(UCHAR(*p))) { /* 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;
+ char *src, *dst;
+
+ /*
+ * Iterate over the string until we hit the terminating null.
+ */
+
+ src = dst = str;
+ while (*src) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst += Tcl_UniCharToUtf(Tcl_UniCharToUpper(ch), dst);
+ }
+ *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;
+ char *src, *dst;
+
+ /*
+ * Iterate over the string until we hit the terminating null.
+ */
+
+ src = dst = str;
+ while (*src) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst += Tcl_UniCharToUtf(Tcl_UniCharToLower(ch), dst);
+ }
+ *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;
+ char *src, *dst;
+
+ /*
+ * Capitalize the first character and then lowercase the rest of the
+ * characters until we get to a null.
+ */
+
+ src = dst = str;
+
+ if (*src) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst += Tcl_UniCharToUtf(Tcl_UniCharToTitle(ch), dst);
+ }
+ while (*src) {
+ src += Tcl_UtfToUniChar(src, &ch);
+ dst += Tcl_UniCharToUtf(Tcl_UniCharToLower(ch), dst);
+ }
+ *dst = '\0';
+ return (dst - str);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ size_t 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_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_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_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/generic/tclUtil.c b/generic/tclUtil.c
index c02c700..54811df 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -5,12 +5,12 @@
* 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.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.4 1999/03/10 05:52:50 stanton Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.5 1999/04/16 00:46:55 stanton Exp $
*/
#include "tclInt.h"
@@ -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:
@@ -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) {
@@ -977,7 +1008,7 @@ Tcl_ConcatObj(objc, objv)
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 +1038,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 +1052,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 +1100,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 +1134,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,971 +1167,68 @@ 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;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
- 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.
- *
- * 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)
- 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. */
-{
- 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.
- */
-
- 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);
-
- 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. */
-{
- Interp *iPtr = (Interp *) interp;
- va_list tmpArgList;
- 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.
- */
-
- 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.
- */
-
- tmpArgList = argList;
- newSpace = 0;
- while (1) {
- string = va_arg(tmpArgList, char *);
- if (string == NULL) {
- break;
- }
- newSpace += strlen(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.
- */
-
- while (1) {
- string = va_arg(argList, char *);
- if (string == NULL) {
- break;
- }
- strcpy(iPtr->appendResult + iPtr->appendUsed, string);
- iPtr->appendUsed += strlen(string);
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * 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. */
- 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.
- */
-
- 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)
- 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);
- }
- 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_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;
-{
- 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;
- }
- return (Tcl_RegExp) iPtr->regexps[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;
+ pattern++;
+ string++;
}
- return Tcl_RegExpExec(interp, re, string, string);
}
/*
@@ -2118,7 +1256,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';
}
/*
@@ -2149,7 +1287,7 @@ Tcl_DStringAppend(dsPtr, string, length)
* up to null at end. */
{
int newSize;
- char *newString, *dst;
+ char *dst;
CONST char *end;
if (length < 0) {
@@ -2164,14 +1302,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;
}
/*
@@ -2213,7 +1355,7 @@ Tcl_DStringAppendElement(dsPtr, string)
* null-terminated. */
{
int newSize, flags;
- char *dst, *newString;
+ char *dst;
newSize = Tcl_ScanElement(string, &flags) + dsPtr->length + 1;
@@ -2227,14 +1369,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;
}
/*
@@ -2277,27 +1423,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;
@@ -2318,8 +1478,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)
@@ -2331,7 +1490,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';
}
/*
@@ -2375,7 +1534,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';
}
/*
@@ -2413,12 +1572,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);
}
@@ -2535,9 +1692,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
@@ -2545,8 +1705,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;
}
}
@@ -2607,9 +1769,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;
}
@@ -2623,6 +1788,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);
@@ -2634,10 +1800,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;
}
@@ -2680,7 +1848,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;
@@ -2691,7 +1860,7 @@ TclNeedSpace(start, end)
}
end--;
} while (*end == '{');
- if (isspace(UCHAR(*end))) {
+ if (isspace(UCHAR(*end))) { /* INTL: ISO space. */
return 0;
}
return 1;
@@ -2732,7 +1901,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.
*/
@@ -2794,22 +1973,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;
}
@@ -2843,30 +2041,26 @@ 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;
- /*
- * 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);
+ bytes = Tcl_GetStringFromObj(objPtr, &length);
if ((*bytes == 'e')
&& (strncmp(bytes, "end", (unsigned) length) == 0)) {
index = endValue;
@@ -2911,3 +2105,56 @@ 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);
+}
+
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 70efd00..03b7757 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.7 1999/02/03 00:55:06 stanton Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.8 1999/04/16 00:46:55 stanton Exp $
*/
#include "tclInt.h"
@@ -77,9 +77,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
@@ -99,17 +97,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. */
@@ -155,33 +149,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;
}
}
@@ -259,6 +258,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
if (createPart1) { /* var wasn't found so create it */
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);
@@ -292,7 +292,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)) {
@@ -451,7 +451,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
* 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.
@@ -471,8 +471,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);
}
/*
@@ -487,7 +486,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.
@@ -507,53 +506,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);
}
-
/*
*----------------------------------------------------------------------
*
@@ -591,20 +554,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) {
@@ -618,7 +618,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);
@@ -687,7 +687,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.
@@ -700,14 +700,13 @@ 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",
@@ -743,7 +742,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);
@@ -765,6 +764,7 @@ TclGetIndexedScalar(interp, localIndex, leaveErrorMsg)
msg = noSuchVar;
}
VarErrMsg(interp, varName, NULL, "read", msg);
+
}
return NULL;
}
@@ -843,11 +843,7 @@ TclGetElementOfIndexedArray(interp, localIndex, elemPtr, leaveErrorMsg)
}
#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;
@@ -945,7 +941,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.
@@ -961,35 +957,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;
}
}
@@ -1006,7 +999,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.
*
@@ -1029,8 +1022,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);
}
/*
@@ -1049,7 +1041,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.
*
@@ -1073,70 +1065,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.
- */
+ *
+ *----------------------------------------------------------------------
+ */
- return TclGetStringFromObj(varValuePtr, (int *) NULL);
+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;
+
+ 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
@@ -1160,7 +1168,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.
*
@@ -1172,40 +1180,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) {
@@ -1342,7 +1337,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);
@@ -1640,11 +1635,7 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr,
}
#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;
@@ -1808,7 +1799,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
@@ -1818,8 +1809,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;
@@ -1827,13 +1820,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,
@@ -1866,8 +1854,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;
}
@@ -2056,7 +2043,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,
@@ -2076,8 +2063,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);
}
/*
@@ -2091,7 +2077,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,
@@ -2109,8 +2095,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;
@@ -2166,7 +2151,7 @@ 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;
@@ -2265,8 +2250,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);
}
/*
@@ -2301,8 +2286,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. */
@@ -2324,7 +2308,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;
@@ -2361,8 +2346,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);
}
/*
@@ -2394,8 +2378,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. */
{
@@ -2406,14 +2389,15 @@ 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) {
if (tracePtr == NULL) {
@@ -2495,7 +2479,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);
}
/*
@@ -2523,8 +2507,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
@@ -2536,7 +2519,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) {
@@ -2599,13 +2582,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;
}
}
@@ -2638,32 +2617,28 @@ Tcl_AppendObjCmd(dummy, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
register Tcl_Obj *varValuePtr = NULL;
- /* Initialized to avoid compiler
- * warning. */
+ /* Initialized to avoid compiler
+ * warning. */
int i;
if (objc < 2) {
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;
}
@@ -2702,10 +2677,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
@@ -2714,7 +2688,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;
@@ -2722,7 +2696,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
@@ -2733,8 +2707,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
@@ -2742,13 +2715,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;
}
@@ -2821,8 +2794,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 */
@@ -2874,14 +2847,15 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
ARRAY_STARTSEARCH};
static char *arrayOptions[] = {"anymore", "donesearch", "exists",
- "get", "names", "nextelement", "set", "size", "startsearch",
- (char *) NULL};
+ "get", "names", "nextelement", "set",
+ "size", "startsearch", (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;
@@ -2890,17 +2864,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);
@@ -2909,7 +2882,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;
@@ -2923,7 +2911,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;
@@ -2958,7 +2946,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;
@@ -3000,7 +2988,7 @@ 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)) {
@@ -3051,7 +3039,7 @@ 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)) {
@@ -3067,7 +3055,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;
}
}
@@ -3086,7 +3074,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;
@@ -3113,73 +3101,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;
@@ -3221,7 +3147,7 @@ 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);
@@ -3247,6 +3173,102 @@ 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;
+
+ varName = TclGetString(arrayNameObj);
+ 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, 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* MakeUpvar --
*
* This procedure does all of the work of the "global" and "upvar"
@@ -3453,7 +3475,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
@@ -3526,7 +3548,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
@@ -3665,7 +3687,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
@@ -3750,7 +3772,7 @@ 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);
@@ -3778,8 +3800,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;
}
@@ -3865,10 +3887,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;
@@ -3886,8 +3908,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;
@@ -3959,9 +3981,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;
@@ -3990,11 +4010,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 {
@@ -4014,7 +4031,6 @@ CallTraces(iPtr, arrayPtr, varPtr, part1, part2, flags)
}
}
}
- flags &= ~TCL_PARSE_PART1;
/*
* Invoke traces on the array containing the variable, if relevant.
@@ -4136,7 +4152,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.
@@ -4316,8 +4332,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) {
@@ -4615,7 +4630,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.
*
diff --git a/library/auto.tcl b/library/auto.tcl
new file mode 100644
index 0000000..7e43aaf
--- /dev/null
+++ b/library/auto.tcl
@@ -0,0 +1,553 @@
+# auto.tcl --
+#
+# utility procs formerly in init.tcl dealing with auto execution
+# of commands and can be auto loaded themselves.
+#
+# RCS: @(#) $Id: auto.tcl,v 1.2 1999/04/16 00:46:56 stanton Exp $
+#
+# 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)
+
+proc tcl_findLibrary {basename version patch initScript enVarName varName} {
+ 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
+
+ lappend dirs [file join [file dirname [info library]] \
+ $basename$version]
+
+ # 3. Various locations relative to the executable
+ # ../lib/foo1.0 (From bin directory in install hierarchy)
+ # ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
+ # ../library (From unix directory in build hierarchy)
+ # ../../library (From unix/arch directory in build hierarchy)
+ # ../../foo1.0b1/library (From unix directory in parallel build hierarchy)
+ # ../../../foo1.0b1/library (From unix/arch directory in parallel build hierarchy)
+
+ 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 {![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 $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
+
+ # 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 {$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 {[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 [list set auto_index([fullname $name])] \
+ " \[list source \[file join \$dir [list $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 {[info commands tbcload::bcproc] == ""} {
+ 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
+ append index [list set auto_index([fullname $name])] \
+ " \[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]
+ $parser eval [list _%@namespace eval $name] $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"}
+ }
+ }
+}
+
+return
diff --git a/library/encoding/ascii.enc b/library/encoding/ascii.enc
new file mode 100644
index 0000000..e0320b8
--- /dev/null
+++ b/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/library/encoding/big5.enc b/library/encoding/big5.enc
new file mode 100644
index 0000000..26179f4
--- /dev/null
+++ b/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/library/encoding/cp1250.enc b/library/encoding/cp1250.enc
new file mode 100644
index 0000000..934539a
--- /dev/null
+++ b/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/library/encoding/cp1251.enc b/library/encoding/cp1251.enc
new file mode 100644
index 0000000..7daed16
--- /dev/null
+++ b/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/library/encoding/cp1252.enc b/library/encoding/cp1252.enc
new file mode 100644
index 0000000..fe55a46
--- /dev/null
+++ b/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/library/encoding/cp1253.enc b/library/encoding/cp1253.enc
new file mode 100644
index 0000000..a934bc9
--- /dev/null
+++ b/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/library/encoding/cp1254.enc b/library/encoding/cp1254.enc
new file mode 100644
index 0000000..d8553a2
--- /dev/null
+++ b/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/library/encoding/cp1255.enc b/library/encoding/cp1255.enc
new file mode 100644
index 0000000..275c016
--- /dev/null
+++ b/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/library/encoding/cp1256.enc b/library/encoding/cp1256.enc
new file mode 100644
index 0000000..1a9d8a6
--- /dev/null
+++ b/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/library/encoding/cp1257.enc b/library/encoding/cp1257.enc
new file mode 100644
index 0000000..4aab0c6
--- /dev/null
+++ b/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/library/encoding/cp1258.enc b/library/encoding/cp1258.enc
new file mode 100644
index 0000000..8c1fce8
--- /dev/null
+++ b/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/library/encoding/cp437.enc b/library/encoding/cp437.enc
new file mode 100644
index 0000000..ecae4e6
--- /dev/null
+++ b/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/library/encoding/cp737.enc b/library/encoding/cp737.enc
new file mode 100644
index 0000000..5b59661
--- /dev/null
+++ b/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/library/encoding/cp775.enc b/library/encoding/cp775.enc
new file mode 100644
index 0000000..71b65c3
--- /dev/null
+++ b/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/library/encoding/cp850.enc b/library/encoding/cp850.enc
new file mode 100644
index 0000000..4e7a90d
--- /dev/null
+++ b/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/library/encoding/cp852.enc b/library/encoding/cp852.enc
new file mode 100644
index 0000000..f34899e
--- /dev/null
+++ b/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/library/encoding/cp855.enc b/library/encoding/cp855.enc
new file mode 100644
index 0000000..4d58b86
--- /dev/null
+++ b/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/library/encoding/cp857.enc b/library/encoding/cp857.enc
new file mode 100644
index 0000000..b42ed55
--- /dev/null
+++ b/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/library/encoding/cp860.enc b/library/encoding/cp860.enc
new file mode 100644
index 0000000..871943b
--- /dev/null
+++ b/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/library/encoding/cp861.enc b/library/encoding/cp861.enc
new file mode 100644
index 0000000..3f8f605
--- /dev/null
+++ b/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/library/encoding/cp862.enc b/library/encoding/cp862.enc
new file mode 100644
index 0000000..5f9d16c
--- /dev/null
+++ b/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/library/encoding/cp863.enc b/library/encoding/cp863.enc
new file mode 100644
index 0000000..c8b8686
--- /dev/null
+++ b/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/library/encoding/cp864.enc b/library/encoding/cp864.enc
new file mode 100644
index 0000000..71f9e62
--- /dev/null
+++ b/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/library/encoding/cp865.enc b/library/encoding/cp865.enc
new file mode 100644
index 0000000..543da9c
--- /dev/null
+++ b/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/library/encoding/cp866.enc b/library/encoding/cp866.enc
new file mode 100644
index 0000000..b851cf5
--- /dev/null
+++ b/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/library/encoding/cp869.enc b/library/encoding/cp869.enc
new file mode 100644
index 0000000..9fd2929
--- /dev/null
+++ b/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/library/encoding/cp874.enc b/library/encoding/cp874.enc
new file mode 100644
index 0000000..cdcca32
--- /dev/null
+++ b/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/library/encoding/cp932.enc b/library/encoding/cp932.enc
new file mode 100644
index 0000000..027f7d8
--- /dev/null
+++ b/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/library/encoding/cp936.enc b/library/encoding/cp936.enc
new file mode 100644
index 0000000..53d975c
--- /dev/null
+++ b/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/library/encoding/cp949.enc b/library/encoding/cp949.enc
new file mode 100644
index 0000000..697fc6f94
--- /dev/null
+++ b/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/library/encoding/cp950.enc b/library/encoding/cp950.enc
new file mode 100644
index 0000000..8816284
--- /dev/null
+++ b/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/library/encoding/dingbats.enc b/library/encoding/dingbats.enc
new file mode 100644
index 0000000..9729487
--- /dev/null
+++ b/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/library/encoding/euc-cn.enc b/library/encoding/euc-cn.enc
new file mode 100644
index 0000000..4b2f8c7
--- /dev/null
+++ b/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/library/encoding/euc-jp.enc b/library/encoding/euc-jp.enc
new file mode 100644
index 0000000..9b7abb1
--- /dev/null
+++ b/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/library/encoding/euc-kr.enc b/library/encoding/euc-kr.enc
new file mode 100644
index 0000000..5e9bb93
--- /dev/null
+++ b/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/library/encoding/gb12345.enc b/library/encoding/gb12345.enc
new file mode 100644
index 0000000..3f3f4d2
--- /dev/null
+++ b/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/library/encoding/gb1988.enc b/library/encoding/gb1988.enc
new file mode 100644
index 0000000..298732c
--- /dev/null
+++ b/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/library/encoding/gb2312.enc b/library/encoding/gb2312.enc
new file mode 100644
index 0000000..813d7a6
--- /dev/null
+++ b/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/library/encoding/iso2022-jp.enc b/library/encoding/iso2022-jp.enc
new file mode 100644
index 0000000..a4e455f
--- /dev/null
+++ b/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/library/encoding/iso2022-kr.enc b/library/encoding/iso2022-kr.enc
new file mode 100644
index 0000000..d20ce2b
--- /dev/null
+++ b/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/library/encoding/iso2022.enc b/library/encoding/iso2022.enc
new file mode 100644
index 0000000..ae7cde1
--- /dev/null
+++ b/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/library/encoding/iso8859-1.enc b/library/encoding/iso8859-1.enc
new file mode 100644
index 0000000..045d8fa
--- /dev/null
+++ b/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/library/encoding/iso8859-2.enc b/library/encoding/iso8859-2.enc
new file mode 100644
index 0000000..16faab6
--- /dev/null
+++ b/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/library/encoding/iso8859-3.enc b/library/encoding/iso8859-3.enc
new file mode 100644
index 0000000..c914bce
--- /dev/null
+++ b/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/library/encoding/iso8859-4.enc b/library/encoding/iso8859-4.enc
new file mode 100644
index 0000000..ef5c5a9
--- /dev/null
+++ b/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/library/encoding/iso8859-5.enc b/library/encoding/iso8859-5.enc
new file mode 100644
index 0000000..bf4ee82
--- /dev/null
+++ b/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/library/encoding/iso8859-6.enc b/library/encoding/iso8859-6.enc
new file mode 100644
index 0000000..6510af7
--- /dev/null
+++ b/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/library/encoding/iso8859-7.enc b/library/encoding/iso8859-7.enc
new file mode 100644
index 0000000..2cb69a2
--- /dev/null
+++ b/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/library/encoding/iso8859-8.enc b/library/encoding/iso8859-8.enc
new file mode 100644
index 0000000..6b424d5
--- /dev/null
+++ b/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/library/encoding/iso8859-9.enc b/library/encoding/iso8859-9.enc
new file mode 100644
index 0000000..6eed3f1
--- /dev/null
+++ b/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/library/encoding/jis0201.enc b/library/encoding/jis0201.enc
new file mode 100644
index 0000000..64f423f
--- /dev/null
+++ b/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/library/encoding/jis0208.enc b/library/encoding/jis0208.enc
new file mode 100644
index 0000000..7102e88
--- /dev/null
+++ b/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/library/encoding/jis0212.enc b/library/encoding/jis0212.enc
new file mode 100644
index 0000000..cddbbba
--- /dev/null
+++ b/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/library/encoding/ksc5601.enc b/library/encoding/ksc5601.enc
new file mode 100644
index 0000000..bec61d0
--- /dev/null
+++ b/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/library/encoding/macCentEuro.enc b/library/encoding/macCentEuro.enc
new file mode 100644
index 0000000..dde616a
--- /dev/null
+++ b/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/library/encoding/macCroatian.enc b/library/encoding/macCroatian.enc
new file mode 100644
index 0000000..132a74c
--- /dev/null
+++ b/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/library/encoding/macCyrillic.enc b/library/encoding/macCyrillic.enc
new file mode 100644
index 0000000..5590833
--- /dev/null
+++ b/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/library/encoding/macDingbats.enc b/library/encoding/macDingbats.enc
new file mode 100644
index 0000000..28449cd
--- /dev/null
+++ b/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/library/encoding/macGreek.enc b/library/encoding/macGreek.enc
new file mode 100644
index 0000000..fbfa51f
--- /dev/null
+++ b/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/library/encoding/macIceland.enc b/library/encoding/macIceland.enc
new file mode 100644
index 0000000..e3fe9a9
--- /dev/null
+++ b/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/library/encoding/macJapan.enc b/library/encoding/macJapan.enc
new file mode 100644
index 0000000..dba24bd
--- /dev/null
+++ b/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/library/encoding/macRoman.enc b/library/encoding/macRoman.enc
new file mode 100644
index 0000000..6cfd749
--- /dev/null
+++ b/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/library/encoding/macRomania.enc b/library/encoding/macRomania.enc
new file mode 100644
index 0000000..ce41cf4
--- /dev/null
+++ b/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/library/encoding/macThai.enc b/library/encoding/macThai.enc
new file mode 100644
index 0000000..7d9c8ad
--- /dev/null
+++ b/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/library/encoding/macTurkish.enc b/library/encoding/macTurkish.enc
new file mode 100644
index 0000000..73e8687
--- /dev/null
+++ b/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/library/encoding/macUkraine.enc b/library/encoding/macUkraine.enc
new file mode 100644
index 0000000..643cc45
--- /dev/null
+++ b/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/library/encoding/shiftjis.enc b/library/encoding/shiftjis.enc
new file mode 100644
index 0000000..c8d2504
--- /dev/null
+++ b/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/library/encoding/symbol.enc b/library/encoding/symbol.enc
new file mode 100644
index 0000000..ffda9e3
--- /dev/null
+++ b/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/library/init.tcl b/library/init.tcl
index c592e01..acd403d 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.28 1999/03/31 22:37:03 welch Exp $
+# RCS: @(#) $Id: init.tcl,v 1.29 1999/04/16 00:46:56 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -16,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.1
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -59,8 +59,8 @@ if {[info exist tcl_pkgPath]} {
if {[info exists __dir]} {
unset __dir
}
-
-# Windows specific initialization to handle case isses with envars
+
+# Windows specific end of initialization
if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
namespace eval tcl {
@@ -373,7 +373,7 @@ 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
@@ -433,7 +433,7 @@ proc auto_qualify {cmd namespace} {
# 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.
@@ -459,8 +459,6 @@ proc auto_import {pattern} {
}
}
-if {[string compare $tcl_platform(platform) windows] == 0} {
-
# auto_execok --
#
# Returns string that indicates name of program to execute if
@@ -472,6 +470,7 @@ if {[string compare $tcl_platform(platform) windows] == 0} {
# Arguments:
# name - Name of a command.
+if {[string compare $tcl_platform(platform) windows] == 0} {
# Windows version.
#
# Note that info executable doesn't work under Windows, so we have to
@@ -532,17 +531,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 {
@@ -572,992 +560,3 @@ proc auto_execok name {
}
}
-# 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_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)
-
-proc tcl_findLibrary {basename version patch initScript enVarName varName} {
- 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
-
- lappend dirs [file join [file dirname [info library]] \
- $basename$version]
-
- # 3. Various locations relative to the executable
- # ../lib/foo1.0 (From bin directory in install hierarchy)
- # ../../lib/foo1.0 (From bin/arch directory in install hierarchy)
- # ../library (From unix directory in build hierarchy)
- # ../../library (From unix/arch directory in build hierarchy)
- # ../../foo1.0b1/library (From unix directory in parallel build hierarchy)
- # ../../../foo1.0b1/library (From unix/arch directory in parallel build hierarchy)
-
- 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 {![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 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
- }
-
- 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 $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
-
- # 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 {$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]
-
- # 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
-
- $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 [list set auto_index([fullname $name])] \
- " \[list source \[file join \$dir [list $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 {[info commands tbcload::bcproc] == ""} {
- 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
- append index [list set auto_index([fullname $name])] \
- " \[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]
- $parser eval [list _%@namespace eval $name] $args
- set contextStack [lrange $contextStack 1 end]
- }
- import {
- variable parser
- variable imports
- foreach pattern $args {
- if {$pattern != "-force"} {
- lappend imports $pattern
- }
- }
- catch {$parser eval [list _%@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 -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] {
- # 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 $type [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/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
new file mode 100644
index 0000000..37676da
--- /dev/null
+++ b/library/msgcat/msgcat.tcl
@@ -0,0 +1,177 @@
+# 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: msgcat.tcl,v 1.2 1999/04/16 00:47:17 stanton Exp $
+
+package provide msgcat 1.0
+
+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.
+#
+# Arguments:
+# src The string to translate.
+#
+# Results:
+# Returns the translatd string.
+
+proc msgcat::mc {src} {
+ set ns [uplevel {namespace current}]
+ foreach loc $::msgcat::loclist {
+ if {[info exists ::msgcat::msgs($loc,$ns,$src)]} {
+ return $::msgcat::msgs($loc,$ns,$src)
+ }
+ }
+ # we have not found the translation
+ return [uplevel 1 [list [namespace origin mcunknown] \
+ $::msgcat::locale $src]]
+}
+
+# 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 {$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.
+#
+# Arguments:
+# locale The current locale.
+# src The string to be translated.
+#
+# Results:
+# Returns the translated value.
+
+proc msgcat::mcunknown {locale src} {
+ 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/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
new file mode 100644
index 0000000..b40a4f3
--- /dev/null
+++ b/library/msgcat/pkgIndex.tcl
@@ -0,0 +1 @@
+package ifneeded msgcat 1.0 [list source [file join $dir msgcat.tcl]]
diff --git a/library/msgcat1.0/msgcat.tcl b/library/msgcat1.0/msgcat.tcl
new file mode 100644
index 0000000..37676da
--- /dev/null
+++ b/library/msgcat1.0/msgcat.tcl
@@ -0,0 +1,177 @@
+# 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: msgcat.tcl,v 1.2 1999/04/16 00:47:17 stanton Exp $
+
+package provide msgcat 1.0
+
+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.
+#
+# Arguments:
+# src The string to translate.
+#
+# Results:
+# Returns the translatd string.
+
+proc msgcat::mc {src} {
+ set ns [uplevel {namespace current}]
+ foreach loc $::msgcat::loclist {
+ if {[info exists ::msgcat::msgs($loc,$ns,$src)]} {
+ return $::msgcat::msgs($loc,$ns,$src)
+ }
+ }
+ # we have not found the translation
+ return [uplevel 1 [list [namespace origin mcunknown] \
+ $::msgcat::locale $src]]
+}
+
+# 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 {$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.
+#
+# Arguments:
+# locale The current locale.
+# src The string to be translated.
+#
+# Results:
+# Returns the translated value.
+
+proc msgcat::mcunknown {locale src} {
+ 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/library/msgcat1.0/pkgIndex.tcl b/library/msgcat1.0/pkgIndex.tcl
new file mode 100644
index 0000000..b40a4f3
--- /dev/null
+++ b/library/msgcat1.0/pkgIndex.tcl
@@ -0,0 +1 @@
+package ifneeded msgcat 1.0 [list source [file join $dir msgcat.tcl]]
diff --git a/library/opt0.1/optparse.tcl b/library/opt/optparse.tcl
index 0442c74..289a39a 100644
--- a/library/opt0.1/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -1,28 +1,24 @@
# optparse.tcl --
#
-# (Private) option parsing package
+# (private) Option parsing package
+# Primarily used internally by the safe:: code.
#
-# This might be documented and exported in 8.1
-# and some function hopefully moved to the C core for
-# efficiency, if there is enough demand. (mail! ;-)
+# 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.
#
-# Author: Laurent Demailly - Laurent.Demailly@sun.com - dl@mail.box.eu.org
-#
-# Credits:
-# this is a complete 'over kill' rewrite by me, from a version
-# written initially with Brent Welch, itself initially
-# based on work with Steve Uhler. Thanks them !
-#
-# RCS: @(#) $Id: optparse.tcl,v 1.3 1998/09/14 18:40:03 stanton Exp $
+# RCS: @(#) $Id: optparse.tcl,v 1.2 1999/04/16 00:47:18 stanton Exp $
-package provide opt 0.3
+package provide opt 0.4.1
namespace eval ::tcl {
# Exported APIs
namespace export OptKeyRegister OptKeyDelete OptKeyError OptKeyParse \
OptProc OptProcArgGiven OptParse \
- Lassign Lvarpop Lvarset Lvarincr Lfirst \
+ Lempty Lget \
+ Lassign Lvarpop Lvarpop1 Lvarset Lvarincr Lfirst Lrest \
SetMax SetMin
@@ -369,7 +365,7 @@ proc ::tcl::OptProcArgGiven {argname} {
}
# Advance to next argument
proc OptNextArg {argsName} {
- uplevel [list Lvarpop $argsName];
+ uplevel [list Lvarpop1 $argsName];
}
#######
@@ -1047,12 +1043,14 @@ proc ::tcl::Lrest {list} {
lrange $list 1 end
}
# Removes the first element of a list
-proc ::tcl::Lvarpop {listName} {
+# 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
-proc ::tcl::Lvarpop2 {listName} {
+# (Like the tclX version)
+proc ::tcl::Lvarpop {listName} {
upvar $listName list;
set el [Lfirst $list];
set list [lrange $list 1 end];
@@ -1093,7 +1091,7 @@ proc ::tcl::SetMin {varname value} {
# everything loaded fine, lets create the test proc:
- OptCreateTestProc
+ # OptCreateTestProc
# Don't need the create temp proc anymore:
- rename OptCreateTestProc {}
+ # rename OptCreateTestProc {}
}
diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl
new file mode 100644
index 0000000..260e572
--- /dev/null
+++ b/library/opt/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/library/opt0.1/pkgIndex.tcl b/library/opt0.1/pkgIndex.tcl
deleted file mode 100644
index 7f2baaf..0000000
--- a/library/opt0.1/pkgIndex.tcl
+++ /dev/null
@@ -1,7 +0,0 @@
-# Tcl package index file, version 1.0
-# This file is NOT generated by the "pkg_mkIndex" command
-# because if someone just did "package require opt", let's just load
-# the package now, so they can readily use it
-# and even "namespace import tcl::*" ...
-# (tclPkgSetup just makes things slow and do not work so well with namespaces)
-package ifneeded opt 0.3 [list source [file join $dir optparse.tcl]]
diff --git a/library/opt0.4/optparse.tcl b/library/opt0.4/optparse.tcl
new file mode 100644
index 0000000..289a39a
--- /dev/null
+++ b/library/opt0.4/optparse.tcl
@@ -0,0 +1,1097 @@
+# 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: optparse.tcl,v 1.2 1999/04/16 00:47:18 stanton Exp $
+
+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 Lfirst Lrest \
+ 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 [Lfirst $program] >= 2
+# while
+# llength [Lfirst $singleStep] == 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 [Lfirst $res];
+ 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} {
+ Lfirst $lst;
+ }
+ # 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 {[Lfirst $item]=="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 [Lfirst $lst] 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} {
+ Lfirst $item
+ }
+
+ # current state
+ proc OptCurState {descriptions} {
+ OptState [OptCurDesc $descriptions];
+ }
+
+ #######
+ # Arguments manipulation
+
+ # Returns the argument that has to be processed now
+ proc OptCurrentArg {lst} {
+ Lfirst $lst;
+ }
+ # 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 [Lfirst $indexLst]] [Lrest $indexLst];
+}
+# 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 [Lfirst $indexLst];
+ 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 [Lrest $indexLst] $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 [Lfirst $indexLst];
+ set targetList [lindex $list $idx];
+ # reduce refcount on targetList
+ Lvarset1nc list $idx {};
+ # recursively replace in targetList
+ Lvarincr targetList [Lrest $indexLst] $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;
+}
+# Returns the first element of a list
+proc ::tcl::Lfirst {list} {
+ lindex $list 0
+}
+# Returns the rest of the list minus first element
+proc ::tcl::Lrest {list} {
+ lrange $list 1 end
+}
+# 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 [Lfirst $list];
+ 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/library/opt0.4/pkgIndex.tcl b/library/opt0.4/pkgIndex.tcl
new file mode 100644
index 0000000..260e572
--- /dev/null
+++ b/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/library/package.tcl b/library/package.tcl
new file mode 100644
index 0000000..cf8d1ba
--- /dev/null
+++ b/library/package.tcl
@@ -0,0 +1,473 @@
+# package.tcl --
+#
+# utility procs formerly in init.tcl which can be loaded on demand
+# for package management.
+#
+# RCS: @(#) $Id: package.tcl,v 1.2 1999/04/16 00:46:56 stanton Exp $
+#
+# 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.
+#
+
+# 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 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]
+
+ # 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
+ }
+
+ # 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 -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] {
+ # 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/library/safe.tcl b/library/safe.tcl
index 44def92..3be7739 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: safe.tcl,v 1.4 1998/11/11 02:39:31 welch Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.5 1999/04/16 00:46:57 stanton Exp $
#
# The implementation is based on namespaces. These naming conventions
@@ -22,7 +22,7 @@
#
# Needed utilities package
-package require opt 0.2;
+package require opt 0.4.1;
# Create the safe namespace
namespace eval ::safe {
@@ -440,6 +440,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.
@@ -884,4 +891,41 @@ 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/library/tclIndex b/library/tclIndex
index 09a7e64..35c7cf6 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -6,16 +6,74 @@
# 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(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/library/word.tcl b/library/word.tcl
index 17b70c6..0c8d576 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -5,15 +5,12 @@
# widgets behave properly for different platforms.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: word.tcl,v 1.3 1998/09/14 18:40:03 stanton Exp $
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
+# RCS: @(#) $Id: word.tcl,v 1.4 1999/04/16 00:46:57 stanton Exp $
# The following variables are used to determine which characters are
# interpreted as white space.
diff --git a/mac/MW_TclHeader.pch b/mac/MW_TclHeader.pch
index 11b5d28..4982c3b 100644
--- a/mac/MW_TclHeader.pch
+++ b/mac/MW_TclHeader.pch
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: MW_TclHeader.pch,v 1.5 1999/04/15 22:38:46 stanton Exp $
+ * RCS: @(#) $Id: MW_TclHeader.pch,v 1.6 1999/04/16 00:47:19 stanton Exp $
*/
/*
@@ -42,8 +42,6 @@
#include "tcl.h"
#include "tclMac.h"
#include "tclInt.h"
-#ifdef TCL_TEST
-#include "tclMacPort.h"
-#endif
+
#pragma export reset
diff --git a/mac/README b/mac/README
index fe37383..8f05bbc 100644
--- a/mac/README
+++ b/mac/README
@@ -1,4 +1,4 @@
-Tcl 8.0.5 for Macintosh
+Tcl 8.1b2 for Macintosh
by Ray Johnson
Scriptics Corporation
@@ -8,7 +8,7 @@ Jim Ingham
Cygnus Solutions
jingham@cygnus.com
-RCS: @(#) $Id: README,v 1.5 1999/04/15 22:38:46 stanton Exp $
+RCS: @(#) $Id: README,v 1.6 1999/04/16 00:47:19 stanton Exp $
1. Introduction
---------------
@@ -21,34 +21,14 @@ 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.
+Internationalization! This is the first Tcl release that features
+can handle international characters.
+
+On the Macintosh, the System Encoding is taken from the script of the
+Finder Font as set in the Views control panel, or in the Finder
+Preferences in OS8.0.
+
+See the main Tcl README for other features new to Tcl 8.
3. Mac specific features
------------------------
@@ -67,8 +47,8 @@ pointers to where you can find more information about the feature.
* 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".
+ under design & construction. Documentatin can be found in the "HTML
+ Docs:tcl8.1" folder 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
@@ -89,6 +69,7 @@ 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
-------------------
@@ -96,7 +77,7 @@ Macintosh Tcl is distributed in three different forms. This
should make it easier to only download what you need. The
packages are as follows:
-mactk8.0.5.sea.hqx
+mactk8.1b2.sea.hqx
This distribution is a "binary" only release. It contains an
installer program that will install a 68k, PowerPC, or Fat
@@ -104,15 +85,15 @@ mactk8.0.5.sea.hqx
it installs the Tcl & Tk libraries in the Extensions folder inside
your System Folder.
-mactcltk-full-8.0.5.sea.hqx
+mactcltk-full-8.1b2.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.5.sea.hqx
+mactcl-source-8.1b2.sea.hqx
- This release contains the complete source for Tcl 8.0. In
+ This release contains the complete source for Tcl 8.1. In
addition, Metrowerks CodeWarrior libraries and project files
are included. However, you must already have the More Files
package to compile this code.
@@ -123,7 +104,7 @@ mactcl-source-8.0.5.sea.hqx
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
+ http://www.scriptics.com/man/tcl8.1/contents.html
Other documentation and sample Tcl scripts can be found at
the Tcl archive site:
@@ -144,14 +125,14 @@ available (see below).
In order to compile Macintosh Tcl you must have the
following items:
- CodeWarrior Pro 2 through 4
- Mac Tcl 8.0 (source)
- More Files 1.4.3, or 1.4.9
+ CodeWarrior Pro 2 or 3
+ Mac Tcl 8.1 (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,
+for earlier versions of CodeWarrior in the folder tcl8.1: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
@@ -181,7 +162,7 @@ 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. Tcl 8.0.5 is compiled with MoreFiles 1.4.9.
+ 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
diff --git a/mac/tclMacAppInit.c b/mac/tclMacAppInit.c
index 2505bd5..c4e4746 100644
--- a/mac/tclMacAppInit.c
+++ b/mac/tclMacAppInit.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacAppInit.c,v 1.4 1999/02/03 02:58:25 stanton Exp $
+ * RCS: @(#) $Id: tclMacAppInit.c,v 1.5 1999/04/16 00:47:19 stanton Exp $
*/
#include "tcl.h"
@@ -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/mac/tclMacBOAAppInit.c b/mac/tclMacBOAAppInit.c
index 173495a..4fc34e8 100644
--- a/mac/tclMacBOAAppInit.c
+++ b/mac/tclMacBOAAppInit.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.2 1998/09/14 18:40:04 stanton Exp $
+ * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.3 1999/04/16 00:47:19 stanton Exp $
*/
#include "tcl.h"
@@ -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/mac/tclMacBOAMain.c b/mac/tclMacBOAMain.c
index ebec082..d863e9c 100644
--- a/mac/tclMacBOAMain.c
+++ b/mac/tclMacBOAMain.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacBOAMain.c,v 1.2 1998/09/14 18:40:04 stanton Exp $
+ * RCS: @(#) $Id: tclMacBOAMain.c,v 1.3 1999/04/16 00:47:19 stanton Exp $
*/
#include "tcl.h"
@@ -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/mac/tclMacChan.c b/mac/tclMacChan.c
index fc53f42..2fbac8f 100644
--- a/mac/tclMacChan.c
+++ b/mac/tclMacChan.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacChan.c,v 1.5 1999/04/15 22:38:46 stanton Exp $
+ * RCS: @(#) $Id: tclMacChan.c,v 1.6 1999/04/16 00:47:19 stanton Exp $
*/
#include "tclInt.h"
@@ -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
@@ -87,12 +85,6 @@ typedef struct FileEvent {
* pointer. */
} FileEvent;
-/*
- * This is defined in tclMacSerial.c.
- */
-
-EXTERN Tcl_Channel TclMacOpenSerialChannel _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, int *errorCode));
/*
* Static routines for this file:
@@ -112,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,
@@ -122,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,
@@ -183,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;
/*
*----------------------------------------------------------------------
@@ -207,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;
}
/*
@@ -238,7 +228,6 @@ FileChannelExitHandler(
ClientData clientData) /* Old window proc */
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
- initialized = 0;
}
/*
@@ -265,6 +254,7 @@ FileSetupProc(
{
FileState *infoPtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -274,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;
@@ -308,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;
@@ -319,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));
@@ -358,6 +351,7 @@ FileEventProc(
{
FileEvent *fileEvPtr = (FileEvent *)evPtr;
FileState *infoPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -370,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);
@@ -434,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;
}
@@ -465,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:
@@ -648,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;
@@ -665,7 +662,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclGetDefaultStdChannel --
+ * TclpGetDefaultStdChannel --
*
* Constructs a channel for the specified standard OS handle.
*
@@ -680,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;
@@ -765,27 +762,24 @@ TclpOpenFileChannel(
{
Tcl_Channel chan;
int mode;
- char *nativeName;
- Tcl_DString buffer;
- int errorCode, port = 0;
+ char *native;
+ Tcl_DString ds, buffer;
+ int errorCode;
mode = GetOpenMode(interp, modeString);
if (mode == -1) {
return NULL;
}
- /*
- * Look for the magic cookies that refer to the modem ports.
- */
-
- 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) {
Tcl_SetErrno(errorCode);
if (interp != (Tcl_Interp *) NULL) {
@@ -816,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
@@ -830,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
@@ -1229,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) {
@@ -1246,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) {
@@ -1270,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:
@@ -1288,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;
@@ -1301,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/mac/tclMacExit.c b/mac/tclMacExit.c
index f7d92c4..347ff4e 100644
--- a/mac/tclMacExit.c
+++ b/mac/tclMacExit.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacExit.c,v 1.3 1998/11/11 07:46:13 jingham Exp $
+ * RCS: @(#) $Id: tclMacExit.c,v 1.4 1999/04/16 00:47:19 stanton Exp $
*/
#include "tclInt.h"
@@ -104,7 +104,7 @@ static ExitToShellDataPtr gExitToShellData = (ExitToShellDataPtr) NULL;
*/
void
-TclPlatformExit(
+TclpExit(
int status) /* Ignored. */
{
TclMacExitHandler();
diff --git a/mac/tclMacFCmd.c b/mac/tclMacFCmd.c
index 7e8fd22..716237e 100644
--- a/mac/tclMacFCmd.c
+++ b/mac/tclMacFCmd.c
@@ -4,12 +4,12 @@
* 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.
*
- * RCS: @(#) $Id: tclMacFCmd.c,v 1.3 1999/04/15 22:38:47 stanton Exp $
+ * RCS: @(#) $Id: tclMacFCmd.c,v 1.4 1999/04/16 00:47:20 stanton Exp $
*/
#include "tclInt.h"
@@ -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,
- const unsigned char *srcName, short dstVRefNum,
- long dstDirID, const unsigned char *dstName));
+ StringPtr srcName, short dstVRefNum,
+ long dstDirID,StringPtr 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 */
- const unsigned char *srcName, /* name of source */
+ StringPtr srcName, /* name of source */
short dstVRefNum, /* volume ref number of dst */
long dstDirID, /* directory id of dst */
- const unsigned char *dstName) /* name of dst directory */
+ StringPtr 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, 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, initialized DString for
- * error reporting. */
-{
+ 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,7 +1194,7 @@ 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. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
OSErr err;
@@ -1114,7 +1237,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,7 +1269,7 @@ 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. */
Tcl_Obj **readOnlyPtrPtr) /* A pointer to return the object with. */
{
OSErr err;
@@ -1179,7 +1302,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,7 +1330,7 @@ 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. */
Tcl_Obj *attributePtr) /* The command line object. */
{
OSErr err;
@@ -1267,7 +1390,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,7 +1418,7 @@ 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. */
Tcl_Obj *readOnlyPtr) /* The command line object. */
{
OSErr err;
@@ -1338,7 +1461,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 +1485,6 @@ SetFileReadOnly(
*
*---------------------------------------------------------------------------
*/
-
int
TclpListVolumes(
Tcl_Interp *interp) /* Interpreter to which to pass the volume list */
@@ -1372,6 +1494,7 @@ TclpListVolumes(
OSErr theError = noErr;
Tcl_Obj *resultPtr, *elemPtr;
short volIndex = 1;
+ Tcl_DString dstr;
resultPtr = Tcl_NewObj();
@@ -1386,7 +1509,7 @@ TclpListVolumes(
*/
while ( 1 ) {
- pb.volumeParam.ioNamePtr = (StringPtr) & name;
+ pb.volumeParam.ioNamePtr = (StringPtr) &name;
pb.volumeParam.ioVolIndex = volIndex;
theError = PBHGetVInfoSync(&pb);
@@ -1394,10 +1517,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/mac/tclMacFile.c b/mac/tclMacFile.c
index 2fc697e..94582bd 100644
--- a/mac/tclMacFile.c
+++ b/mac/tclMacFile.c
@@ -5,12 +5,12 @@
* 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.
*
- * RCS: @(#) $Id: tclMacFile.c,v 1.5 1999/03/10 05:52:51 stanton Exp $
+ * RCS: @(#) $Id: tclMacFile.c,v 1.6 1999/04/16 00:47:20 stanton Exp $
*/
/*
@@ -34,164 +34,10 @@
/*
* 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;
-}
/*
*----------------------------------------------------------------------
@@ -200,7 +46,7 @@ Tcl_WaitPid(
*
* 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:
@@ -216,7 +62,7 @@ Tcl_WaitPid(
void
Tcl_FindExecutable(
- char *argv0) /* The value of the application's argv[0]. */
+ 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,28 @@ 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);
}
/*
*----------------------------------------------------------------------
*
- * TclMatchFiles --
+ * TclpMatchFiles --
*
* 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,13 +119,14 @@ TclGetUserHome(
*---------------------------------------------------------------------- */
int
-TclMatchFiles(
+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. */
+ * point to a location in pattern and must
+ * not be static.*/
{
char *dirName, *patternEnd = tail;
char savedChar;
@@ -313,7 +139,7 @@ TclMatchFiles(
long dirID;
short itemIndex;
Str255 fileName;
-
+ Tcl_DString fileString;
/*
* Make sure that the directory part of the name really is a
@@ -368,11 +194,12 @@ 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);
if (tail == NULL) {
if ((dirPtr->length > 1) &&
(strchr(dirPtr->string+1, ':') == NULL)) {
@@ -384,10 +211,12 @@ TclMatchFiles(
Tcl_DStringAppend(dirPtr, ":", 1);
result = TclDoGlob(interp, separators, dirPtr, tail);
if (result != TCL_OK) {
+ Tcl_DStringFree(&fileString);
break;
}
}
}
+ Tcl_DStringFree(&fileString);
itemIndex++;
}
@@ -399,25 +228,23 @@ TclMatchFiles(
/*
*----------------------------------------------------------------------
*
- * 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 +252,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 +268,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 +282,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 +472,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 +529,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 +541,7 @@ TclMacReadlink(
*/
} else {
errno = EINVAL;
- return -1;
+ return NULL;
}
}
}
@@ -621,50 +550,49 @@ 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 --
+ * TclpStat --
*
- * 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 stat().
*
* Results:
- * See access documentation.
+ * See stat() documentation.
*
* Side effects:
- * See access documentation.
+ * See stat() documentation.
*
*----------------------------------------------------------------------
*/
int
-TclpAccess(
- const char *path,
- int mode)
+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 +600,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 +614,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 +629,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 +751,8 @@ TclpAccess(
#undef fopen
FILE *
TclMacFOpenHack(
- const char *path,
- const char *mode)
+ CONST char *path,
+ CONST char *mode)
{
OSErr err;
FSSpec fileSpec;
diff --git a/mac/tclMacInit.c b/mac/tclMacInit.c
index 13015a5..6bf6169 100644
--- a/mac/tclMacInit.c
+++ b/mac/tclMacInit.c
@@ -3,59 +3,518 @@
*
* 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.
*
- * RCS: @(#) $Id: tclMacInit.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacInit.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
+#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);
/*
- * Define the tcl_platfrom variable.
+ * 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);
+ }
+ }
+
+ /*
+ * 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);
}
/*
@@ -148,7 +580,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 +593,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 +664,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 +683,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/mac/tclMacInt.h b/mac/tclMacInt.h
index 494cf8b..f721e0f 100644
--- a/mac/tclMacInt.h
+++ b/mac/tclMacInt.h
@@ -3,12 +3,12 @@
*
* 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.
*
- * RCS: @(#) $Id: tclMacInt.h,v 1.3 1999/03/10 05:52:51 stanton Exp $
+ * RCS: @(#) $Id: tclMacInt.h,v 1.4 1999/04/16 00:47:20 stanton Exp $
*/
#ifndef _TCLMACINT
@@ -46,8 +46,15 @@
*/
typedef pascal void (*ExitToShellProcPtr)(void);
-#include "tclIntPlatDecls.h"
+/*
+ * Prototypes of Mac only internal functions.
+ */
+EXTERN char * TclMacGetFontEncoding _ANSI_ARGS_((int fontId));
+EXTERN int TclMacHaveThreads(void);
+
+#include "tclIntPlatDecls.h"
+
#pragma export reset
#endif /* _TCLMACINT */
diff --git a/mac/tclMacLibrary.r b/mac/tclMacLibrary.r
index e775d94..eda1f7f 100644
--- a/mac/tclMacLibrary.r
+++ b/mac/tclMacLibrary.r
@@ -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: tclMacLibrary.r,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacLibrary.r,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#include <Types.r>
@@ -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/mac/tclMacLoad.c b/mac/tclMacLoad.c
index 9c84ac8..622eb65 100644
--- a/mac/tclMacLoad.c
+++ b/mac/tclMacLoad.c
@@ -5,12 +5,12 @@
* 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.
*
- * RCS: @(#) $Id: tclMacLoad.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacLoad.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#include <CodeFragments.h>
@@ -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(fileName), fileName, &fileSpec);
+ Tcl_DStringFree(&ds);
+
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/mac/tclMacNotify.c b/mac/tclMacNotify.c
index a652c8d..773490f 100644
--- a/mac/tclMacNotify.c
+++ b/mac/tclMacNotify.c
@@ -5,12 +5,16 @@
* 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
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacNotify.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacNotify.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#include "tclInt.h"
@@ -22,6 +26,7 @@
#include <LowMem.h>
#include <Processes.h>
#include <Timer.h>
+#include <Threads.h>
/*
@@ -81,9 +86,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 +209,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.
@@ -246,6 +348,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
@@ -346,6 +471,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 +517,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/mac/tclMacOSA.c b/mac/tclMacOSA.c
index d4bc14d..b09cb59 100644
--- a/mac/tclMacOSA.c
+++ b/mac/tclMacOSA.c
@@ -12,7 +12,7 @@
* See the file "License Terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacOSA.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacOSA.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#define MAC_TCL
@@ -1926,7 +1926,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 +2057,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 +2276,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;
diff --git a/mac/tclMacPort.h b/mac/tclMacPort.h
index 558fecd..7be4938 100644
--- a/mac/tclMacPort.h
+++ b/mac/tclMacPort.h
@@ -10,20 +10,27 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacPort.h,v 1.7 1999/03/11 00:19:24 stanton Exp $
+ * RCS: @(#) $Id: tclMacPort.h,v 1.8 1999/04/16 00:47:21 stanton Exp $
*/
+
#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,85 @@
#elif defined(__MWERKS__)
# include <time.h>
# include <unistd.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 +135,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,57 +177,57 @@
# 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 strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
+#define TCL_SHLIB_EXT ".shlb"
+/*
+ * 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...
+ *
+ */
+
+#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 TclpGetUserHome(n, b) (NULL)
+#define TclSetSystemEnv(a,b)
#define tzset()
-#define TclpGetPid(pid) ((unsigned long) (pid))
/*
* The following defines replace the Macintosh version of the POSIX
@@ -202,12 +243,11 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
#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)
-#define TclpAsyncMark(async)
+
+EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2, size_t n));
/*
* These definitions force putenv & company to use the version
@@ -223,21 +263,21 @@ 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.
+ * Platform specific mutex definition used by memory allocators.
+ * These are all no-ops on the Macintosh, since the threads are
+ * all cooperative.
*/
-#define TclpFinalize()
+#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 */
#endif /* _MACPORT */
diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
index 77879b4..312ef42 100644
--- a/mac/tclMacResource.c
+++ b/mac/tclMacResource.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacResource.c,v 1.4 1998/11/10 06:49:44 jingham Exp $
+ * RCS: @(#) $Id: tclMacResource.c,v 1.5 1999/04/16 00:47:21 stanton Exp $
*/
#include <Errors.h>
@@ -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;
}
@@ -530,7 +537,7 @@ resourceRef? resourceType");
break;
case O_WRONLY:
case O_RDWR:
- macPermision = fsRdWrShPerm;
+ macPermision = fsRdWrPerm;
break;
default:
panic("Tcl_ResourceObjCmd: invalid mode value");
@@ -552,7 +559,7 @@ resourceRef? resourceType");
if (fileRef == -1) {
err = ResError();
if (((err == fnfErr) || (err == eofErr)) &&
- (macPermision == fsRdWrShPerm)) {
+ (macPermision == fsRdWrPerm)) {
/*
* No resource fork existed for this file. Since we are
* opening it for writing we will create the resource fork
@@ -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;
}
}
@@ -1700,7 +1704,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 +1917,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 +1934,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/mac/tclMacResource.r b/mac/tclMacResource.r
index f0671b9..f9376db 100644
--- a/mac/tclMacResource.r
+++ b/mac/tclMacResource.r
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacResource.r,v 1.2 1998/09/14 18:40:06 stanton Exp $
+ * RCS: @(#) $Id: tclMacResource.r,v 1.3 1999/04/16 00:47:21 stanton Exp $
*/
#include <Types.r>
@@ -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/mac/tclMacShLib.exp b/mac/tclMacShLib.exp
index aea4acf..020380f 100644
--- a/mac/tclMacShLib.exp
+++ b/mac/tclMacShLib.exp
@@ -251,7 +251,6 @@ TclEmitForwardJump
TclExecuteByteCode
TclExpandCodeArray
TclExpandJumpFixupArray
-TclExpandParseValue
TclExprFloatError
TclFileAttrsCmd
TclFileCopyCmd
@@ -322,9 +321,6 @@ TclObjIndexForString
TclObjInterpProc
TclObjInvoke
TclObjInvokeGlobal
-TclParseBraces
-TclParseNestedCmd
-TclParseQuotes
TclPlatformExit
TclPlatformInit
TclPreventAliasLoop
@@ -530,7 +526,6 @@ Tcl_GlobalEvalObj
Tcl_GlobalObjCmd
Tcl_HashStats
Tcl_HideCommand
-Tcl_HistoryCmd
Tcl_IfCmd
Tcl_Import
Tcl_IncrCmd
diff --git a/mac/tclMacSock.c b/mac/tclMacSock.c
index 17436da..d387cb5 100644
--- a/mac/tclMacSock.c
+++ b/mac/tclMacSock.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacSock.c,v 1.3 1999/04/15 22:38:47 stanton Exp $
+ * RCS: @(#) $Id: tclMacSock.c,v 1.4 1999/04/16 00:47:21 stanton Exp $
*/
#include "tclInt.h"
@@ -82,9 +82,6 @@ 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;
@@ -243,11 +240,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.
@@ -287,64 +288,77 @@ 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);
+
+ /*
+ * 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.
- */
-
- 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.
+ * Do per-thread initialization.
*/
- 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);
+ }
}
/*
@@ -373,13 +387,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.
@@ -396,12 +409,10 @@ SocketExitHandler(
*/
int
-TclHasSockets(
+TclpHasSockets(
Tcl_Interp *interp) /* Interp for error messages. */
{
- if (!initialized) {
- InitSockets();
- }
+ InitSockets();
if (hasSockets) {
return TCL_OK;
@@ -437,6 +448,7 @@ SocketSetupProc(
{
TcpState *statePtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -446,7 +458,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;
@@ -483,6 +495,7 @@ SocketCheckProc(
TcpState *statePtr;
SocketEvent *evPtr;
TcpState dummyState;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -494,7 +507,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
@@ -1112,7 +1125,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:
@@ -1213,26 +1226,8 @@ 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;
@@ -1491,6 +1486,7 @@ NewSocketInfo(
StreamPtr tcpStream)
{
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
statePtr->tcpStream = tcpStream;
@@ -1500,10 +1496,8 @@ NewSocketInfo(
statePtr->watchMask = 0;
statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
statePtr->acceptProcData = (ClientData) NULL;
- statePtr->writeBuffer = (void *) NULL;
- statePtr->writeBufferSize = 0;
- statePtr->nextPtr = socketList;
- socketList = statePtr;
+ statePtr->nextPtr = tsdPtr->socketList;
+ tsdPtr->socketList = statePtr;
return statePtr;
}
@@ -1528,22 +1522,19 @@ 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);
}
@@ -1570,7 +1561,7 @@ Tcl_MakeTcpClientChannel(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return NULL;
}
@@ -1797,7 +1788,7 @@ Tcl_OpenTcpClient(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1848,7 +1839,7 @@ Tcl_OpenTcpServer(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1903,6 +1894,7 @@ SocketEventProc(
TcpState *statePtr;
SocketEvent *eventPtr = (SocketEvent *) evPtr;
int mask = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -1912,7 +1904,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)) {
@@ -2154,7 +2146,7 @@ Tcl_GetHostName()
return hostname;
}
- if (TclHasSockets(NULL) == TCL_OK) {
+ if (TclpHasSockets(NULL) == TCL_OK) {
err = GetLocalAddress(&ourAddress);
if (err == noErr) {
/*
@@ -2294,10 +2286,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.
@@ -2349,7 +2342,7 @@ GetHostFromString(
EventRecord dummy;
DNRState dnrState;
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return 0;
}
@@ -2564,7 +2557,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.
@@ -2632,8 +2625,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);
diff --git a/mac/tclMacTclCode.r b/mac/tclMacTclCode.r
new file mode 100644
index 0000000..1a8f3ca
--- /dev/null
+++ b/mac/tclMacTclCode.r
@@ -0,0 +1,36 @@
+/*
+ * 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";
diff --git a/mac/tclMacThrd.c b/mac/tclMacThrd.c
new file mode 100644
index 0000000..7790e5f
--- /dev/null
+++ b/mac/tclMacThrd.c
@@ -0,0 +1,795 @@
+/*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadCreate --
+ *
+ * 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
+TclpThreadCreate(idPtr, proc, clientData)
+ Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+{
+
+ if (!TclMacHaveThreads()) {
+ return TCL_ERROR;
+ }
+
+#if TARGET_CPU_68K && TARGET_RT_MAC_CFM
+ {
+ ThreadEntryProcPtr entryProc;
+ entryProc = NewThreadEntryProc(proc);
+
+ NewThread(kCooperativeThread, entryProc, (void *) clientData,
+ TCL_MAC_THRD_DEFAULT_STACK, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
+ }
+#else
+ NewThread(kCooperativeThread, proc, (void *) clientData,
+ TCL_MAC_THRD_DEFAULT_STACK, 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
+}
+
+#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/mac/tclMacThrd.h b/mac/tclMacThrd.h
new file mode 100644
index 0000000..22f2c83
--- /dev/null
+++ b/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/mac/tclMacUnix.c b/mac/tclMacUnix.c
index 8d99ee3..483780c 100644
--- a/mac/tclMacUnix.c
+++ b/mac/tclMacUnix.c
@@ -7,12 +7,12 @@
* 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.
*
- * RCS: @(#) $Id: tclMacUnix.c,v 1.2 1998/09/14 18:40:07 stanton Exp $
+ * RCS: @(#) $Id: tclMacUnix.c,v 1.3 1999/04/16 00:47:22 stanton Exp $
*/
#include <Files.h>
@@ -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/tests/README b/tests/README
index 07915c9..fe4bb30 100644
--- a/tests/README
+++ b/tests/README
@@ -1,96 +1,423 @@
-Tcl Test Suite
---------------
+README -- Tcl test suite design document.
-RCS: @(#) $Id: README,v 1.2 1998/09/14 18:40:07 stanton Exp $
+RCS: @(#) $Id: README,v 1.3 1999/04/16 00:47:22 stanton Exp $
-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. Definitions file
+ 3. Writing a new test
+ 4. Constraints
+ 5. Adding a New Test File
+ 6. Test output
+ 7. Selecting tests for execution within a file
+ 8. Selecting files to be sourced by all.tcl
+ 9. 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:
+
+ -verbose <level> set the level of verbosity to a substring
+ of "bps". See the "Test output" section
+ 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 <globPattern> only source test files that match
+ <globPattern> (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.
+
+ (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:
-------------------------------
+ of the tests, type "source all.tcl". To use the options in
+ interactive mode, you can set their corresponding tcltest
+ namespace variables after sourcing the defs.tcl file.
+ ::tcltest::match
+ ::tcltest::skip
+ ::tcltest::testConfig(nonPortable)
+ ::tcltest::testConfig(knownBug)
+ ::tcltest::testConfig(userInteractive)
+
+In all cases, no output will be generated if all goes well, except for
+a listing of the test files and a statistical summary. If there are
+errors, then additional messages will appear in the format described
+below. Note that some tests will be skipped if you run as superuser.
+
+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.
+
+
+2. Definitions file:
+--------------------
+
+The file "defs.tcl" defines the "tcltest" namespace which contains 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.
+Currently, the following procedures are exported from the "tcltest"
+namespace and automatically imported:
+
+ test Run a test script.
+
+ cleanupTests Print stats and remove files created by tests.
+
+ dotests Source a test file and run tests of the
+ specified pattern.
+
+ makeFile Create a file--the file will automatically
+ be removed by cleanupTests.
+
+ removeFile Force a file to be removed.
+
+ makeDirectory Create a directory--the directory will
+ automatically be removed by cleanupTests.
+
+ removeDirectory Force a directory to be removed.
+
+ viewFile Returns the contents of a file.
+
+ normalizeMsg Remove extra newlines from a string.
+
+ bytestring Construct a string that consists of the
+ requested sequence of bytes, as opposed to a
+ string of properly formed UTF-8 characters.
+
+ set_iso8859_1_locale Set the locale to iso8859_1.
+
+ restore_locale Restore the locale to its original setting.
+
+ saveState Save the procedure and global variable names.
+
+ restoreState Restore the procedure and global variable names.
+
+Please refer to the defs.tcl file for more documentation on these
+procedures.
+
+
+3. Writing a new test:
+----------------------
+
+The test 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 "test" command:
+
+ test <name> <description> ?<constraint>? <script> <expectedAnswer>
+
+The <name> argument should follow the pattern,
+"<target>-<majorNum>.<minorNum>". 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.
+
+The <description> argument is a short textual description of the test,
+to help humans understand what it does.
+
+The optional <constraints> argument is 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 false or does
+not exist, the test is skipped. 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:
+
+ test getAttribute-1.1 {testing file permissions} {unixOnly} {
+ lindex [file attributes foo.tcl] 5
+ } {00644}
+
+See the "Constraints" section for a list of built-in
+constraints and information on how to add your own constraints.
+
+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.
+
+The <expectedAnswer> argument will be compared against the result of
+evaluating the <script> argument. If they match, the test passes,
+otherwise the test fails.
+
+
+4. Constraints:
+---------------
+
+Constraints are used to determine whether a test should be skipped.
+Each constraint is stored as an index in the array
+::tcltest::testConfig. For example, the unixOnly constraint is
+defined as the following:
+
+ set ::tcltest::testConfig(unixOnly) \
+ [expr {$tcl_platform(platform) == "unix"}]
+
+If a test is constrained by "unixOnly", then it will only be run if
+the value of ::tcltest::testConfig(unixOnly) is true.
+
+The following is a list of constraints defined in the defs.tcl file:
+
+unix test can only be run on any UNIX platform
+pc test can only be run on any Windows platform
+nt test can only be run on any Windows NT platform
+95 test can only be run on any Windows 95 platform
+mac test can only be run on any Mac platform
+unixOrPc test can only be run on a UNIX or PC platform
+macOrPc test can only be run on a Mac or PC platform
+macOrUnix test can only be run on a Mac or UNIX platform
+tempNotPc test can not be run on Windows. This flag is used
+ to temporarily disable a test.
+tempNotMac test can not be run on a Mac. This flag is used
+ to temporarily disable a test.
+unixCrash test crashes if it's run on UNIX. This flag is used
+ to temporarily disable a test.
+pcCrash test crashes if it's run on Windows. This flag is
+ used to temporarily disable a test.
+macCrash test crashes if it's run on a Mac. This flag is used
+ to temporarily disable a test.
+
+emptyTest 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.
+
+knownBug 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.
+
+nonPortable 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. See the
+ "Introduction" section for more details.
+
+userInteraction test requires interaction from the user. This
+ constraint always causes tests to be skipped unless
+ the user specifies otherwise. See the "Introduction"
+ section for more details.
+
+interactive test can only be run in if the interpreter is in
+ interactive mode, that is the global tcl_interactive
+ variable is set to 1.
+
+nonBlockFiles test can only be run if platform supports setting
+ files into nonblocking mode
+
+asyncPipeClose test can only be run if platform supports async
+ flush and async close on a pipe
+
+unixExecs test can only be run if this machine has commands
+ such as 'cat', 'echo', etc. available.
+
+hasIsoLocale test can only be run if can switch to an ISO locale
+
+fonts test can only be run if the wish app's fonts can
+ be controlled by Tk.
+
+root test can only run if Unix user is root
+
+notRoot test can only run if Unix user is not root
+
+eformat test can only run if app has a working version of
+ sprintf with respect to the "e" format of
+ floating-point numbers.
+
+stdio test can only be run if the current app can be
+ spawned via a pipe
+
+
+5. Adding a new test file:
+--------------------------
+
+Tests files should begin by sourcing the defs.tcl file:
+
+ if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+ }
+
+Test files sould end by cleaning up after themselves and calling
+::tcltest::cleanupTests. The ::tcltest::cleanupTests procedure prints
+statistics about the number of tests that passed, skipped, and failed,
+and removes all files that were created using the ::tcltest::makeFile
+and ::tcltest::makeDirectory procedures.
+
+ # Remove files created by these tests
+ # Change to original working directory
+ # Unset global arrays
+ ::tcltest::cleanupTests
+ return
+
+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.
+
+
+6. Test output:
+---------------
+
+After all specified test files are sourced, the number of tests
+passed, skipped, and failed is printed to stdout. Aside from this
+statistical information, output can be controlled on a per-test basis
+by the ::tcltest::verbose variable.
+
+::tcltest::verbose 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 ::tcltest::verbose 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.
+
+You can set ::tcltest::verbose either interactively (after the defs.tcl
+file has been sourced) or by the command line argument -verbose, for
+example:
+
+ tcltest socket.test -verbose bps
+
+
+7. Selecting tests for execution within a file:
+-----------------------------------------------
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:
+sourced. An individual test will be skipped if one of the following
+conditions is met:
+
+ 1) the "name" of the tests does not match (using glob style
+ matching) one or more elements in the ::tcltest::match
+ variable
+
+ 2) the "name" of the tests matches (using glob style matching) one
+ or more elements in the ::tcltest::skip variable
+
+ 3) the "constraints" argument to the "test" call, if given,
+ contains one or more false elements.
+
+You can set ::tcltest::match and/or ::tcltest::skip
+either interactively (after the defs.tcl file has been sourced), or by
+the command line arguments -match and -skip, for example:
+
+ tcltest info.test -match '*-5.* *-7.*' -skip '*-7.1*'
+
+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.
+
+The two predefined constraints (knownBug and nonPortable) can be
+overridden either interactively (after the defs.tcl file has been
+sourced) by setting the ::tcltest::testConfig(<constraint>) variable,
+or by using the -constraints 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 knownBug and nonPortable
+restricions:
+
+ tcltest all.tcl -constraints "knownBug nonPortable"
+
+See the defs.tcl file for information about each of these constraints.
+Other constraints can be added at any time. See the "Writing a new
+test" section below for more details about using built-in constraints
+and adding new ones.
+
+
+8. Selecting files to be sourced by all.tcl:
+--------------------------------------------
+
+You can specify the files you want all.tcl to source on the command
+line with the -file options. For example, if you call the
+following:
+
+ tcltest all.tcl -file 'unix*.test'
+
+all files in "tests" directory that match the pattern unix*.test will
+be sourced by the all.tcl file. Another useful example is if a
+particular test hangs, say "get.test", and you just want to run the
+remaining tests, then you can call the following:
+
+ tcltest all.tcl -file '[h-z]*.test'
+
+Note that the argument to -file will be substituted relative to the
+"tests" directory. Be sure to use the proper quoting convention so
+that your shell does not perform the glob substitution.
+
- set TESTS {for-[24]*}
+9. Incompatibilities with prior Tcl versions:
+---------------------------------------------
-TESTS defaults to *, but you can change the default in "defs" if
-you wish.
+1) Global variables such as VERBOSE, TESTS, and testConfig are now
+ renamed to use the new "tcltest" namespace.
-Saving keystrokes:
-------------------
+ old name new name
+ -------- --------
+ VERBOSE ::tcltest::verbose
+ TESTS ::tcltest::match
+ testConfig ::tcltest::testConfig
-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.
+ The introduction of the "tcltest" namespace is a precursor to using
+ a "tcltest" package. This next step will be part of a future Tcl
+ version.
-Batch vs. interactive execution:
---------------------------------
+2) VERBOSE values are no longer numeric. Please see the section above
+ on "Test output" for the new usage of the ::tcltest::verbose variable.
-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:
+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.
- tclTest < parse.test > parse.test.results
+4) The "all", "defs", and "visual" files are now called "all.tcl",
+ "defs.tcl", and "visual_bb.test", respectively.
-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).
+5) 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::testConfig(nonPortable) variable to 1 (after
+ sourcing the defs.tcl file).
diff --git a/tests/all b/tests/all
deleted file mode 100644
index 04ac435..0000000
--- a/tests/all
+++ /dev/null
@@ -1,71 +0,0 @@
-# This file contains a top-level script to run all of the Tcl
-# tests. Execute it by invoking "source all" when running tclTest
-# in this directory.
-#
-# RCS: @(#) $Id: all,v 1.5 1998/12/07 23:33:53 hershey Exp $
-
-set TESTS_DIR [file join [pwd] [file dirname [info script]]]
-source [file join $TESTS_DIR defs]
-set currentDir [pwd]
-
-catch {array set flag $argv}
-set requiredSourceFiles [list autoMkindex.tcl remote.tcl defs pkg pkg1]
-
-#
-# Set the TMP_DIR to pwd or the arg of -tmpdir, if given.
-#
-
-if {[info exists flag(-tmpdir)]} {
- set TMP_DIR $flag(-tmpdir)
- if {![file exists $TMP_DIR]} {
- if {[catch {file mkdir $TMP_DIR} msg]} {
- error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$msg"
- }
- file mkdir $TMP_DIR
- } elseif {![file isdir $TMP_DIR]} {
- error "bad argument \"$flag(-tmpdir)\" to -tmpdir:\n$TMP_DIR is not a directory"
- }
- if {[string compare [file pathtype $TMP_DIR] absolute] != 0} {
- set TMP_DIR [file join [pwd] $TMP_DIR]
- }
- cd $TMP_DIR
-}
-
-#
-# copy each required source file to the current dir (if it's not already there).
-#
-
-if {[string compare $TESTS_DIR [pwd]] != 0} {
-
- foreach file $requiredSourceFiles {
- if {![file exists $file]} {
- catch {file copy [file join $TESTS_DIR $file] .}
- }
- }
-}
-
-if {$tcl_platform(os) == "Win32s"} {
- set globPattern [file join $TESTS_DIR *.tes]
-} else {
- set globPattern [file join $TESTS_DIR *.test]
-}
-
-foreach file [lsort [glob $globPattern]] {
- set tail [file tail $file]
- if {[string match l.*.test $tail]} {
- # This is an SCCS lockfile; ignore it
- continue
- }
- puts stdout $tail
- if {[catch {source $file} msg]} {
- puts stdout $msg
- }
-}
-
-# remove the required source files from the current dir.
-if {[info exists TMP_DIR]} {
- foreach file $requiredSourceFiles {
- catch {file delete -force $file}
- }
- cd $currentDir
-}
diff --git a/tests/all.tcl b/tests/all.tcl
new file mode 100644
index 0000000..a6c596a
--- /dev/null
+++ b/tests/all.tcl
@@ -0,0 +1,76 @@
+# 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-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: all.tcl,v 1.2 1999/04/16 00:47:23 stanton Exp $
+
+if {[lsearch ::tcltest [namespace children]] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+set ::tcltest::testSingleFile false
+
+puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]"
+puts stdout "Tests running in working dir: $::tcltest::workingDir"
+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"
+}
+
+# Use command line specified glob pattern (specified by -file or -f)
+# if one exists. Otherwise use *.test. If given, the file pattern
+# should be specified relative to the dir containing this file. If no
+# files are found to match the pattern, print an error message and exit.
+set fileIndex [expr {[lsearch $argv "-file"] + 1}]
+set fIndex [expr {[lsearch $argv "-f"] + 1}]
+if {($fileIndex < 1) || ($fIndex > $fileIndex)} {
+ set fileIndex $fIndex
+}
+if {$fileIndex > 0} {
+ set globPattern [file join $::tcltest::testsDir [lindex $argv $fileIndex]]
+ puts stdout "Sourcing files that match: $globPattern"
+} else {
+ set globPattern [file join $::tcltest::testsDir *.test]
+}
+set fileList [glob -nocomplain $globPattern]
+if {[llength $fileList] < 1} {
+ puts "Error: no files found matching $globPattern"
+ exit
+}
+set timeCmd {clock format [clock seconds]}
+puts stdout "Tests began at [eval $timeCmd]"
+
+# source each of the specified tests
+foreach file [lsort $fileList] {
+ set tail [file tail $file]
+ if {[string match l.*.test $tail]} {
+ # This is an SCCS lockfile; ignore it
+ continue
+ }
+ 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/tests/append.test b/tests/append.test
index d4ccba3..e64df06 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -6,15 +6,18 @@
#
# 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: append.test,v 1.2 1998/09/14 18:40:07 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+# RCS: @(#) $Id: append.test,v 1.3 1999/04/16 00:47:23 stanton Exp $
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {unset x}
+
test append-1.1 {append command} {
catch {unset x}
list [append x 1 2 abc "long string"] $x
@@ -170,5 +173,22 @@ 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/tests/assocd.test b/tests/assocd.test
index 48ef00b..a618606 100644
--- a/tests/assocd.test
+++ b/tests/assocd.test
@@ -6,17 +6,21 @@
#
# 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: assocd.test,v 1.2 1998/09/14 18:40:07 stanton Exp $
+# RCS: @(#) $Id: assocd.test,v 1.3 1999/04/16 00:47:23 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +59,19 @@ 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/tests/async.test b/tests/async.test
index 9bacf3c..4b4d655 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -6,20 +6,24 @@
#
# 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: async.test,v 1.2 1998/09/14 18:40:07 stanton Exp $
+# RCS: @(#) $Id: async.test,v 1.3 1999/04/16 00:47:23 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +132,19 @@ 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/tests/autoMkindex.test b/tests/autoMkindex.test
index 562454b..452eed6 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -4,15 +4,39 @@
# 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: autoMkindex.test,v 1.4 1999/03/31 18:58:50 welch Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+# RCS: @(#) $Id: autoMkindex.test,v 1.5 1999/04/16 00:47:23 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# temporarily copy the autoMkindex.tcl file from testsDir to tmpDir
+set origMkindexFile [file join $::tcltest::testsDir autoMkindex.tcl]
+set newMkindexFile [file join $::tcltest::workingDir 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 saveCommands $auto_mkindex_parser::initCommands
set result ""
test autoMkindex-1.1 {remove any existing tclIndex file} {
@@ -28,6 +52,8 @@ 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
@@ -43,6 +69,8 @@ test autoMkindex-1.3 {examine tclIndex} {
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 {}
@@ -69,11 +97,12 @@ test autoMkindex-3.1 {slaveHook} {
}
}
auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
+ file delete tclIndex
auto_mkindex . autoMkindex.tcl
# Reset initCommands to avoid trashing other tests
- set auto_mkindex_parser::initCommands $saveCommands
+ AutoMkindexTestReset
file exists tclIndex
} 1
@@ -87,6 +116,7 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} {
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 "."
@@ -101,7 +131,7 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} {
# Reset initCommands to avoid trashing other tests
- set auto_mkindex_parser::initCommands $saveCommands
+ 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}"
@@ -114,6 +144,7 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
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 "."
@@ -128,7 +159,7 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
# Reset initCommands to avoid trashing other tests
- set auto_mkindex_parser::initCommands $saveCommands
+ AutoMkindexTestReset
proc lvalue {list pattern} {
set ix [lsearch $list $pattern]
if {$ix >= 0} {
@@ -140,12 +171,19 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
-
-#
# Clean up.
-#
-set auto_mkindex_parser::initCommands $saveCommands
unset result
-unset saveCommands
-catch {file delete tclIndex}
+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
+}
+::tcltest::cleanupTests
diff --git a/tests/basic.test b/tests/basic.test
index 43f92cb..b6274bf 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -10,14 +10,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: basic.test,v 1.4 1998/09/14 18:40:07 stanton Exp $
+# RCS: @(#) $Id: basic.test,v 1.5 1999/04/16 00:47:23 stanton Exp $
#
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {namespace delete test_ns_basic}
catch {interp delete test_interp}
@@ -40,7 +43,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 +92,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 +111,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 +126,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 +151,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 +179,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 +197,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 +226,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 +244,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 +259,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 +268,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 +276,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 +296,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 +316,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 +325,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 +351,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 +374,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 +392,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 +412,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 +478,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} {
+} {{info tclversion} {info tclversion} {set stuff [info tclversion]} {set stuff 8.1}}
+test basic-39.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {
testcmdtrace deletetest {set stuff [info tclversion]}
-} 8.0
+} 8.1
}
+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 +529,17 @@ catch {rename q ""}
catch {rename cmd ""}
catch {rename value:at: ""}
catch {unset x}
-set x 0
-unset x
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/binary.test b/tests/binary.test
index 70ddf0c..1399edd 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -5,20 +5,23 @@
# 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: binary.test,v 1.2 1998/09/14 18:40:07 stanton Exp $
+# RCS: @(#) $Id: binary.test,v 1.3 1999/04/16 00:47:23 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +1444,19 @@ 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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/case.test b/tests/case.test
index e36b3b3..ee0b97f 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -6,13 +6,16 @@
#
# 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: case.test,v 1.2 1998/09/14 18:40:07 stanton Exp $
+# RCS: @(#) $Id: case.test,v 1.3 1999/04/16 00:47:23 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test case-1.1 {simple pattern} {
case a in a {format 1} b {format 2} c {format 3} default {format 4}
@@ -81,3 +84,19 @@ 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/tests/clock.test b/tests/clock.test
index 5fbee3a..d0072ad 100644
--- a/tests/clock.test
+++ b/tests/clock.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) 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: clock.test,v 1.2 1998/09/14 18:40:07 stanton Exp $
+# RCS: @(#) $Id: clock.test,v 1.3 1999/04/16 00:47:24 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test clock-1.1 {clock tests} {
list [catch {clock} msg] $msg
@@ -41,29 +44,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 +135,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]
@@ -173,3 +207,19 @@ 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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index f9251a9..19ef9c4 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -4,35 +4,179 @@
# 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: cmdAH.test,v 1.4 1999/02/03 19:12:27 stanton Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.5 1999/04/16 00:47:24 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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} {
+test cmdAH-5.3 {Tcl_FileObjCmd} {
list [catch {file atime} msg] $msg
-} {1 {wrong # args: should be "file atime name ?arg ...?"}}
+} {1 {wrong # args: should be "file atime 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 +184,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 +207,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 +384,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 +393,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 +402,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 +414,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 +587,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 +596,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 +605,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 +614,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,139 +791,139 @@ 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\\
} {}
@@ -796,56 +940,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 +1006,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 +1038,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 +1052,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 +1068,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 +1081,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 +1093,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 +1105,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 +1131,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 +1155,65 @@ catch {exec chmod 765 gorp.file}
# atime
-test cmdAH-16.1 {Tcl_FileObjCmd: atime} {
+test cmdAH-20.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} {
+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}}}
# 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 +1222,10 @@ catch {unset stat}
# mtime
-test cmdAH-20.1 {Tcl_FileObjCmd: mtime} {
+test cmdAH-24.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} {
+test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
set old [file mtime gorp.file]
after 2000
set f [open gorp.file w]
@@ -1091,17 +1234,17 @@ 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.
@@ -1111,9 +1254,8 @@ test cmdAH-20.5 {Tcl_FileObjCmd: mtime} {
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]
@@ -1125,43 +1267,43 @@ test cmdAH-20.5 {Tcl_FileObjCmd: mtime} {
# 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 +1311,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,88 +1322,141 @@ 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 {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} {
+test cmdAH-30.2 {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} {
+test cmdAH-30.3 {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} {
+test cmdAH-30.4 {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} {
+test cmdAH-30.5 {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} {
+test cmdAH-30.6 {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} {
+test cmdAH-30.7 {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} {
+test cmdAH-30.8 {error conditions} {
list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}
+# cleanup
catch {testsetplatform $platform}
catch {unset platform}
@@ -1270,4 +1465,20 @@ file delete -force dir.file
file delete gorp.file
file delete link.file
-concat ""
+cd $cmdAHwd
+
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index cd7cf31..ac39ec0 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -3,14 +3,16 @@
# 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: cmdIL.test,v 1.5 1998/10/13 20:30:23 rjohnson Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.6 1999/04/16 00:47:24 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
list [catch {lsort} msg] $msg
@@ -255,7 +257,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 +288,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 +307,19 @@ test cmdIL-4.25 {DictionaryCompare procedure, signed characters} {
}
set viewlist
} [list "abc" "abc\\200"]
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index 661caa4..ad18e70 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -8,20 +8,24 @@
#
# 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: cmdInfo.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: cmdInfo.test,v 1.3 1999/04/16 00:47:24 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +97,20 @@ 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/tests/cmdMZ.test b/tests/cmdMZ.test
new file mode 100644
index 0000000..4cd72d2
--- /dev/null
+++ b/tests/cmdMZ.test
@@ -0,0 +1,581 @@
+# The tests in this file cover the procedures in tclCmdMZ.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) 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: cmdMZ.test,v 1.2 1999/04/16 00:47:24 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# Tcl_PwdObjCmd
+
+test cmdMZ-1.1 {Tcl_PwdObjCmd} {
+ list [catch {pwd a} msg] $msg
+} {1 {wrong # args: should be "pwd"}}
+test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
+ catch pwd
+} 0
+test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
+ expr [string length pwd]>0
+} 1
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unixOnly} {
+ file delete -force foo
+ file mkdir foo
+ set cwd [pwd]
+ cd foo
+ file attr . -permissions 000
+ set result [list [catch {pwd} msg] $msg]
+ cd $cwd
+ file delete -force foo
+ set result
+} {1 {error getting working directory name: permission denied}}
+
+# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test
+
+# Tcl_RenameObjCmd
+
+test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
+ list [catch {rename r1} msg] $msg $errorCode
+} {1 {wrong # args: should be "rename oldName newName"} NONE}
+test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
+ list [catch {rename r1 r2 r3} msg] $msg $errorCode
+} {1 {wrong # args: should be "rename oldName newName"} NONE}
+test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
+ catch {rename r2 {}}
+ proc r1 {} {return "r1"}
+ rename r1 r2
+ r2
+} {r1}
+test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
+ proc r1 {} {return "r1"}
+ rename r1 {}
+ list [catch {r1} msg] $msg
+} {1 {invalid command name "r1"}}
+
+# The tests for Tcl_ReturnObjCmd are in proc-old.test
+# The tests for Tcl_ScanObjCmd are in scan.test
+
+# Tcl_SourceObjCmd
+
+test cmdMZ-3.1 {Tcl_SourceObjCmd: error conditions} {macOnly} {
+ list [catch {source} msg] $msg
+} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+test cmdMZ-3.2 {Tcl_SourceObjCmd: error conditions} {macOnly} {
+ list [catch {source a b} msg] $msg
+} {1 {wrong # args: should be "source fileName" or "source -rsrc name ?fileName?" or "source -rsrcid id ?fileName?"}}
+test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
+ list [catch {source} msg] $msg
+} {1 {wrong # args: should be "source fileName"}}
+test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} {unixOrPc} {
+ list [catch {source a b} msg] $msg
+} {1 {wrong # args: should be "source fileName"}}
+test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} {
+ makeFile {
+ set x 146
+ error "error in sourced file"
+ set y $x
+ } source.file
+ list [catch {source source.file} msg] $msg $errorInfo
+} {1 {error in sourced file} {error in sourced file
+ while executing
+"error "error in sourced file""
+ (file "source.file" line 3)
+ invoked from within
+"source source.file"}}
+test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
+ makeFile {list result} source.file
+ source source.file
+} result
+
+# Tcl_SplitObjCmd
+
+test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
+ list [catch split msg] $msg $errorCode
+} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
+ list [catch {split a b c} msg] $msg $errorCode
+} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
+ split "a\n b\t\r c\n "
+} {a {} b {} {} c {} {}}
+test cmdMZ-4.4 {Tcl_SplitObjCmd: basic split commands} {
+ split "word 1xyzword 2zword 3" xyz
+} {{word 1} {} {} {word 2} {word 3}}
+test cmdMZ-4.5 {Tcl_SplitObjCmd: basic split commands} {
+ split "12345" {}
+} {1 2 3 4 5}
+test cmdMZ-4.6 {Tcl_SplitObjCmd: basic split commands} {
+ split "a\}b\[c\{\]\$"
+} "a\\}b\\\[c\\{\\\]\\\$"
+test cmdMZ-4.7 {Tcl_SplitObjCmd: basic split commands} {
+ split {} {}
+} {}
+test cmdMZ-4.8 {Tcl_SplitObjCmd: basic split commands} {
+ split {}
+} {}
+test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
+ split { }
+} {{} {} {} {}}
+test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
+ proc foo {} {
+ set x {}
+ foreach f [split {]\n} {}] {
+ append x $f
+ }
+ return $x
+ }
+ foo
+} {]\n}
+test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
+ proc foo {} {
+ set x ab\000c
+ set y [split $x {}]
+ return $y
+ }
+ foo
+} "a b \000 c"
+test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
+ split "a0ab1b2bbb3\000c4" ab\000c
+} {{} 0 {} 1 2 {} {} 3 {} 4}
+test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
+ # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
+ 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, totitle, 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} {
+ string tolower ABCabc\xc7\xe7
+} "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} {
+ string toupper ABCabc\xc7\xe7
+} "ABCABC\xc7\xc7"
+
+test cmdMZ-15.1 {Tcl_StringObjCmd: string totitle} {
+ list [catch {string totitle} msg] $msg
+} {1 {wrong # args: should be "string totitle string"}}
+test cmdMZ-15.2 {Tcl_StringObjCmd: string totitle} {
+ list [catch {string totitle a b} msg] $msg
+} {1 {wrong # args: should be "string totitle string"}}
+test cmdMZ-15.3 {Tcl_StringObjCmd: string totitle} {
+ string totitle abCDEf
+} {Abcdef}
+test cmdMZ-15.4 {Tcl_StringObjCmd: string totitle} {
+ string totitle "abc xYz"
+} {Abc xyz}
+test cmdMZ-15.5 {Tcl_StringObjCmd: string totitle} {
+ string totitle {123#$&*()}
+} {123#$&*()}
+test cmdMZ-15.6 {Tcl_StringObjCmd: string totitle, unicode} {
+ string totitle ABCabc\xc7\xe7
+} "Abcabc\xe7\xe7"
+test cmdMZ-15.7 {Tcl_StringObjCmd: string totitle, unicode} {
+ string totitle \u01f3BCabc\xc7\xe7
+} "\u01f2bcabc\xe7\xe7"
+
+test cmdMZ-16.1 {Tcl_StringObjCmd: string trim} {
+ list [catch {string trim} msg] $msg
+} {1 {wrong # args: should be "string trim string ?chars?"}}
+test cmdMZ-16.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-16.3 {Tcl_StringObjCmd: string trim} {
+ string trim " XYZ "
+} {XYZ}
+test cmdMZ-16.4 {Tcl_StringObjCmd: string trim} {
+ string trim "\t\nXYZ\t\n\r\n"
+} {XYZ}
+test cmdMZ-16.5 {Tcl_StringObjCmd: string trim} {
+ string trim " A XYZ A "
+} {A XYZ A}
+test cmdMZ-16.6 {Tcl_StringObjCmd: string trim} {
+ string trim "XXYYZZABC XXYYZZ" ZYX
+} {ABC }
+test cmdMZ-16.7 {Tcl_StringObjCmd: string trim} {
+ string trim " \t\r "
+} {}
+test cmdMZ-16.8 {Tcl_StringObjCmd: string trim} {
+ string trim {abcdefg} {}
+} {abcdefg}
+test cmdMZ-16.9 {Tcl_StringObjCmd: string trim} {
+ string trim {}
+} {}
+test cmdMZ-16.10 {Tcl_StringObjCmd: string trim} {
+ string trim ABC DEF
+} {ABC}
+test cmdMZ-16.11 {Tcl_StringObjCmd: string trim, unicode} {
+ string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
+} " AB\xe7C "
+
+test cmdMZ-17.1 {Tcl_StringObjCmd: string trimleft} {
+ string trimleft " XYZ "
+} {XYZ }
+test cmdMZ-17.2 {Tcl_StringObjCmd: string trimleft} {
+ list [catch {string trimleft} msg] $msg
+} {1 {wrong # args: should be "string trimleft string ?chars?"}}
+test cmdMZ-17.3 {Tcl_StringObjCmd: string trimleft} {
+ string length [string trimleft " "]
+} {0}
+
+test cmdMZ-18.1 {Tcl_StringObjCmd: string trimright} {
+ string trimright " XYZ "
+} { XYZ}
+test cmdMZ-18.2 {Tcl_StringObjCmd: string trimright} {
+ string trimright " "
+} {}
+test cmdMZ-18.3 {Tcl_StringObjCmd: string trimright} {
+ string trimright ""
+} {}
+test cmdMZ-18.4 {Tcl_StringObjCmd: string trimright errors} {
+ list [catch {string trimright} msg] $msg
+} {1 {wrong # args: should be "string trimright string ?chars?"}}
+test cmdMZ-18.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, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+
+test cmdMZ-19.1 {Tcl_StringObjCmd: string wordend} {
+ list [catch {string wordend a} msg] $msg
+} {1 {wrong # args: should be "string wordend string index"}}
+test cmdMZ-19.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-19.3 {Tcl_StringObjCmd: string wordend} {
+ list [catch {string wordend a gorp} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test cmdMZ-19.4 {Tcl_StringObjCmd: string wordend} {
+ string wordend abc. -1
+} 3
+test cmdMZ-19.5 {Tcl_StringObjCmd: string wordend} {
+ string wordend abc. 100
+} 4
+test cmdMZ-19.6 {Tcl_StringObjCmd: string wordend} {
+ string wordend "word_one two three" 2
+} 8
+test cmdMZ-19.7 {Tcl_StringObjCmd: string wordend} {
+ string wordend "one .&# three" 5
+} 6
+test cmdMZ-19.8 {Tcl_StringObjCmd: string wordend} {
+ string worde "x.y" 0
+} 1
+test cmdMZ-19.9 {Tcl_StringObjCmd: string wordend, unicode} {
+ string wordend "xyz\u00c7de fg" 0
+} 6
+test cmdMZ-19.10 {Tcl_StringObjCmd: string wordend, unicode} {
+ string wordend "xyz\uc700de fg" 0
+} 6
+test cmdMZ-19.11 {Tcl_StringObjCmd: string wordend, unicode} {
+ string wordend "xyz\u203fde fg" 0
+} 6
+test cmdMZ-19.12 {Tcl_StringObjCmd: string wordend, unicode} {
+ string wordend "xyz\u2045de fg" 0
+} 3
+test cmdMZ-19.13 {Tcl_StringObjCmd: string wordend, unicode} {
+ string wordend "\uc700\uc700 abc" 8
+} 6
+
+test cmdMZ-20.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, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+test cmdMZ-20.2 {Tcl_StringObjCmd: string wordstart} {
+ list [catch {string wordstart a} msg] $msg
+} {1 {wrong # args: should be "string wordstart string index"}}
+test cmdMZ-20.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-20.4 {Tcl_StringObjCmd: string wordstart} {
+ list [catch {string wordstart a gorp} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test cmdMZ-20.5 {Tcl_StringObjCmd: string wordstart} {
+ string wordstart "one two three_words" 400
+} 8
+test cmdMZ-20.6 {Tcl_StringObjCmd: string wordstart} {
+ string wordstart "one two three_words" 2
+} 0
+test cmdMZ-20.7 {Tcl_StringObjCmd: string wordstart} {
+ string wordstart "one two three_words" -2
+} 0
+test cmdMZ-20.8 {Tcl_StringObjCmd: string wordstart} {
+ string wordstart "one .*&^ three" 6
+} 6
+test cmdMZ-20.9 {Tcl_StringObjCmd: string wordstart} {
+ string wordstart "one two three" 4
+} 4
+test cmdMZ-20.10 {Tcl_StringObjCmd: string wordstart, unicode} {
+ string wordstart "one tw\u00c7o three" 7
+} 4
+test cmdMZ-20.11 {Tcl_StringObjCmd: string wordstart, unicode} {
+ string wordstart "ab\uc700\uc700 cdef ghi" 12
+} 10
+test cmdMZ-20.12 {Tcl_StringObjCmd: string wordstart, unicode} {
+ string wordstart "\uc700\uc700 abc" 8
+} 3
+
+# 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/tests/compExpr-old.test b/tests/compExpr-old.test
new file mode 100644
index 0000000..5e1fa9a
--- /dev/null
+++ b/tests/compExpr-old.test
@@ -0,0 +1,687 @@
+# 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: compExpr-old.test,v 1.2 1999/04/16 00:47:24 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+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
+unset a
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/compExpr.test b/tests/compExpr.test
new file mode 100644
index 0000000..17728b9
--- /dev/null
+++ b/tests/compExpr.test
@@ -0,0 +1,340 @@
+# 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: compExpr.test,v 1.2 1999/04/16 00:47:25 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+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/tests/compile.test b/tests/compile.test
index 14f8864..382e85e 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -5,13 +5,16 @@
# 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: compile.test,v 1.5 1999/02/02 22:26:12 stanton Exp $
+# RCS: @(#) $Id: compile.test,v 1.6 1999/04/16 00:47:25 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.
@@ -69,6 +72,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 +90,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 +101,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 +109,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 +118,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 +129,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 +138,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 +150,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 +161,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,7 +181,7 @@ test compile-6.1 {UpdateStringOfByteCode: called for duplicate of compiled empty
p
} {}
-test compile-7.1 {BLACKBOX: exception stack overflow} {
+test compile-10.1 {BLACKBOX: exception stack overflow} {
set x {{0}}
set y 0
while {$y < 100} {
@@ -179,10 +190,25 @@ test compile-7.1 {BLACKBOX: exception stack overflow} {
} {}
+
+# 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/tests/concat.test b/tests/concat.test
index a0d819d..69a4f21 100644
--- a/tests/concat.test
+++ b/tests/concat.test
@@ -6,13 +6,16 @@
#
# 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: concat.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: concat.test,v 1.3 1999/04/16 00:47:25 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test concat-1.1 {simple concatenation} {
concat a b c d e f g
@@ -44,3 +47,19 @@ 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/tests/dcall.test b/tests/dcall.test
index 6cd4908..2114071 100644
--- a/tests/dcall.test
+++ b/tests/dcall.test
@@ -6,20 +6,24 @@
#
# 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: dcall.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: dcall.test,v 1.3 1999/04/16 00:47:25 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +42,19 @@ 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/tests/defs b/tests/defs
deleted file mode 100644
index 21c9458..0000000
--- a/tests/defs
+++ /dev/null
@@ -1,460 +0,0 @@
-# This file contains support code for the Tcl test suite. 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 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: defs,v 1.5 1998/12/04 04:18:20 hershey Exp $
-
-if {![info exists VERBOSE]} {
- set VERBOSE 0
-}
-if {![info exists TESTS]} {
- set TESTS {}
-}
-
-# If tests are being run as root, issue a warning message and set a
-# variable to prevent some tests from running at all.
-
-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}
- if {$user == "root"} {
- puts stdout "Warning: you're executing as root. I'll have to"
- puts stdout "skip some of the tests, since they'll fail as root."
- set testConfig(root) 1
- }
-}
-
-# Some of the tests don't work on some system configurations due to
-# differences in word length, file system configuration, etc. In order
-# to prevent false alarms, these tests are generally only run in the
-# master development directory for Tcl. The presence of a file
-# "doAllTests" in this directory is used to indicate that the non-portable
-# tests should be run.
-
-# 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 {}
-}
-
-# Check configuration information that will determine which tests
-# to run. To do this, create an array testConfig. Each element
-# has a 0 or 1 value, and the following elements are defined:
-# unixOnly - 1 means this is a UNIX platform, so it's OK
-# to run tests that only work under UNIX.
-# macOnly - 1 means this is a Mac platform, so it's OK
-# to run tests that only work on Macs.
-# pcOnly - 1 means this is a PC platform, so it's OK to
-# run tests that only work on PCs.
-# unixOrPc - 1 means this is a UNIX or PC platform.
-# macOrPc - 1 means this is a Mac or PC platform.
-# macOrUnix - 1 means this is a Mac or UNIX platform.
-# nonPortable - 1 means this the tests are being running 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. The presence
-# of the file "doAllTests" in this directory indicates
-# that it is safe to run non-portable tests.
-# knownBug - The test is known to fail and the bug is not yet
-# fixed. The test will be run only if the file
-# "doBuggyTests" exists (intended for Tcl dev. group
-# internal use only).
-# tempNotPc - The inverse of pcOnly. This flag is used to
-# temporarily disable a test.
-# tempNotMac - The inverse of macOnly. This flag is used to
-# temporarily disable a test.
-# nonBlockFiles - 1 means this platform supports setting files into
-# nonblocking mode.
-# asyncPipeClose- 1 means this platform supports async flush and
-# async close on a pipe.
-# unixExecs - 1 means this machine has commands such as 'cat',
-# 'echo' etc available.
-# notIfCompiled - 1 means this that it is safe to run tests that
-# might fail if the bytecode compiler is used. This
-# element is set 1 if the file "doAllTests" exists in
-# this directory. Normally, this element is 0 so that
-# tests that fail with the bytecode compiler are
-# skipped. As of 11/2/96 these are the history tests
-# since they depend on accurate source location
-# information.
-
-catch {unset testConfig}
-if {$tcl_platform(platform) == "unix"} {
- set testConfig(unixOnly) 1
- set testConfig(tempNotPc) 1
- set testConfig(tempNotMac) 1
-} else {
- set testConfig(unixOnly) 0
-}
-if {$tcl_platform(platform) == "macintosh"} {
- set testConfig(tempNotPc) 1
- set testConfig(macOnly) 1
-} else {
- set testConfig(macOnly) 0
-}
-if {$tcl_platform(platform) == "windows"} {
- set testConfig(tempNotMac) 1
- set testConfig(pcOnly) 1
-} else {
- set testConfig(pcOnly) 0
-}
-set testConfig(unixOrPc) [expr {$testConfig(unixOnly) || $testConfig(pcOnly)}]
-set testConfig(macOrPc) [expr {$testConfig(macOnly) || $testConfig(pcOnly)}]
-set testConfig(macOrUnix) [expr {$testConfig(macOnly) || $testConfig(unixOnly)}]
-set testConfig(nonPortable) [expr {[file exists doAllTests] || [file exists doAllTe]}]
-set testConfig(knownBug) [expr {[file exists doBuggyTests] || [file exists doBuggyT]}]
-set testConfig(notIfCompiled) [file exists doAllCompilerTests]
-
-set testConfig(unix) $testConfig(unixOnly)
-set testConfig(mac) $testConfig(macOnly)
-set testConfig(pc) $testConfig(pcOnly)
-
-set testConfig(nt) [expr {$tcl_platform(os) == "Windows NT"}]
-set testConfig(95) [expr {$tcl_platform(os) == "Windows 95"}]
-set testConfig(win32s) [expr {$tcl_platform(os) == "Win32s"}]
-
-# 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 testConfig(pcCrash) $testConfig(macOrUnix)
-set testConfig(macCrash) $testConfig(unixOrPc)
-set testConfig(unixCrash) $testConfig(macOrPc)
-
-if {[catch {set f [open defs r]}]} {
- set testConfig(nonBlockFiles) 1
-} else {
- if {[catch {fconfigure $f -blocking off}] == 0} {
- set testConfig(nonBlockFiles) 1
- } else {
- set testConfig(nonBlockFiles) 0
- }
- close $f
-}
-
-trace variable testConfig r safeFetch
-
-proc safeFetch {n1 n2 op} {
- global testConfig
-
- if {($n2 != {}) && ([info exists testConfig($n2)] == 0)} {
- set testConfig($n2) 0
- }
-}
-
-# 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 testConfig(asyncPipeClose) 0
- } else {
- set testConfig(asyncPipeClose) 1
- }
-} else {
- set 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 testConfig(eformat) 1
-if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
- set testConfig(eformat) 0
- puts stdout "(will skip tests that depend on the \"e\" format of floating-point numbers)"
-}
-# Test to see if execed commands such as cat, echo, rm and so forth are
-# present on this machine.
-
-set testConfig(unixExecs) 1
-if {$tcl_platform(platform) == "macintosh"} {
- set testConfig(unixExecs) 0
-}
-if {($testConfig(unixExecs) == 1) && ($tcl_platform(platform) == "windows")} {
- if {[catch {exec cat defs}] == 1} {
- set testConfig(unixExecs) 0
- }
- if {($testConfig(unixExecs) == 1) && ([catch {exec echo hello}] == 1)} {
- set testConfig(unixExecs) 0
- }
- if {($testConfig(unixExecs) == 1) && \
- ([catch {exec sh -c echo hello}] == 1)} {
- set testConfig(unixExecs) 0
- }
- if {($testConfig(unixExecs) == 1) && ([catch {exec wc defs}] == 1)} {
- set testConfig(unixExecs) 0
- }
- if {$testConfig(unixExecs) == 1} {
- exec echo hello > removeMe
- if {[catch {exec rm removeMe}] == 1} {
- set testConfig(unixExecs) 0
- }
- }
- if {($testConfig(unixExecs) == 1) && ([catch {exec sleep 1}] == 1)} {
- set testConfig(unixExecs) 0
- }
- if {($testConfig(unixExecs) == 1) && \
- ([catch {exec fgrep unixExecs defs}] == 1)} {
- set testConfig(unixExecs) 0
- }
- if {($testConfig(unixExecs) == 1) && ([catch {exec ps}] == 1)} {
- set testConfig(unixExecs) 0
- }
- if {($testConfig(unixExecs) == 1) && \
- ([catch {exec echo abc > removeMe}] == 0) && \
- ([catch {exec chmod 644 removeMe}] == 1) && \
- ([catch {exec rm removeMe}] == 0)} {
- set testConfig(unixExecs) 0
- } else {
- catch {exec rm -f removeMe}
- }
- if {($testConfig(unixExecs) == 1) && \
- ([catch {exec mkdir removeMe}] == 1)} {
- set testConfig(unixExecs) 0
- } else {
- catch {exec rm -r removeMe}
- }
- if {$testConfig(unixExecs) == 0} {
- puts stdout "Warning: Unix-style executables are not available, so"
- puts stdout "some tests will be skipped."
- }
-}
-
-proc print_verbose {name description constraints script code answer} {
- puts stdout "\n"
- if {[string length $constraints]} {
- puts stdout "==== $name $description\t--- ($constraints) ---"
- } else {
- puts stdout "==== $name $description"
- }
- puts stdout "==== Contents of test case:"
- puts stdout "$script"
- if {$code != 0} {
- if {$code == 1} {
- puts stdout "==== Test generated error:"
- puts stdout $answer
- } elseif {$code == 2} {
- puts stdout "==== Test generated return exception; result was:"
- puts stdout $answer
- } 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 $answer
- }
- } else {
- puts stdout "==== Result was:"
- puts stdout "$answer"
- }
-}
-
-# test --
-# This procedure runs a test and prints an error message if the
-# test fails. If 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 TESTS variable, 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 "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.
-# answer - Expected result from script.
-
-proc test {name description script answer args} {
- global VERBOSE TESTS testConfig
-
- if {[string compare $TESTS ""] != 0} {
- set ok 0
- foreach test $TESTS {
- if {[string match $test $name]} {
- set ok 1
- break
- }
- }
- if {!$ok} {
- 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 $answer
- set answer [lindex $args 0]
- set doTest 0
- if {[string match {*[$\[]*} $constraints] != 0} {
- # full expression, e.g. {$foo > [info tclversion]}
-
- catch {set doTest [uplevel #0 expr [list $constraints]]} msg
- } elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
- # something like {a || b} should be turned into
- # $testConfig(a) || $testConfig(b).
-
- regsub -all {[.a-zA-Z0-9]+} $constraints {$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 testConfig($constraint)]
- || !$testConfig($constraint)} {
- set doTest 0
- break
- }
- }
- }
- if {$doTest == 0} {
- if {$VERBOSE} {
- puts stdout "++++ $name SKIPPED: $constraints"
- }
- return
- }
- } else {
- error "wrong # args: must be \"test name description ?constraints? script answer\""
- }
- memory tag $name
- set code [catch {uplevel $script} result]
- if {$code != 0} {
- print_verbose $name $description $constraints $script \
- $code $result
- } elseif {[string compare $result $answer] == 0} {
- if {$VERBOSE} {
- if {$VERBOSE > 0} {
- print_verbose $name $description $constraints $script \
- $code $result
- }
- if {$VERBOSE != -2} {
- puts stdout "++++ $name PASSED"
- }
- }
- } else {
- print_verbose $name $description $constraints $script \
- $code $result
- puts stdout "---- Result should have been:"
- puts stdout "$answer"
- puts stdout "---- $name FAILED"
- }
-}
-
-proc dotests {file args} {
- global TESTS
- set savedTests $TESTS
- set TESTS $args
- source $file
- set TESTS $savedTests
-}
-
-proc normalizeMsg {msg} {
- regsub "\n$" [string tolower $msg] "" msg
- regsub -all "\n\n" $msg "\n" msg
- regsub -all "\n\}" $msg "\}" msg
- return $msg
-}
-
-proc 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
-}
-
-proc removeFile {name} {
- file delete $name
-}
-
-proc makeDirectory {name} {
- file mkdir $name
-}
-
-proc removeDirectory {name} {
- file delete -force $name
-}
-
-proc viewFile {name} {
- global tcl_platform testConfig
- if {($tcl_platform(platform) == "macintosh") || \
- ($testConfig(unixExecs) == 0)} {
- set f [open $name]
- set data [read -nonewline $f]
- close $f
- return $data
- } else {
- exec cat $name
- }
-}
-
-# Locate tcltest executable
-
-set tcltest [info nameofexecutable]
-
-if {$tcltest == "{}"} {
- set tcltest {}
- puts stdout "Unable to find tcltest executable, multiple process tests will fail."
-}
-
-if {$tcl_platform(os) != "Win32s"} {
- # Don't even try running another copy of tcltest under win32s, or you
- # get an error dialog about multiple instances.
-
- 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 testConfig(stdio) 1
- }
- catch {file delete -force tmp}
-}
-
-if {($tcl_platform(platform) == "windows") && ($testConfig(stdio) == 0)} {
- puts stdout "(will skip tests that redirect stdio of exec'd 32-bit applications)"
-}
-
-catch {socket} msg
-set testConfig(socket) [expr {$msg != "sockets are not available on this system"}]
-
-if {$testConfig(socket) == 0} {
- puts stdout "(will skip tests that use sockets)"
-}
-
-
diff --git a/tests/defs.tcl b/tests/defs.tcl
new file mode 100644
index 0000000..1e7d8fc
--- /dev/null
+++ b/tests/defs.tcl
@@ -0,0 +1,990 @@
+# 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: defs.tcl,v 1.2 1999/04/16 00:47:26 stanton Exp $
+
+# 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]
+ 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 {}
+}
+
+# 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
+ }
+}
+
+# Need to catch the import because it fails if defs.tcl is sourced
+# more than once.
+catch {namespace import ::tcltest::*}
+return
diff --git a/tests/dstring.test b/tests/dstring.test
index 5b17b7d..e614b97 100644
--- a/tests/dstring.test
+++ b/tests/dstring.test
@@ -6,20 +6,24 @@
#
# 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: dstring.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: dstring.test,v 1.3 1999/04/16 00:47:26 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +249,19 @@ 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/tests/encoding.test b/tests/encoding.test
new file mode 100644
index 0000000..3852749
--- /dev/null
+++ b/tests/encoding.test
@@ -0,0 +1,316 @@
+# 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: encoding.test,v 1.2 1999/04/16 00:47:26 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+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::testConfig(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 jis0208 ;# incr ref count
+ testencoding path .
+ set x [encoding convertto jis0208 \u4e4e] ;# old one found
+ encoding system identity
+ lappend x [catch {encoding convertto jis0208 \u4e4e} msg] $msg
+ encoding system identity
+ testencoding path $path
+ encoding system $system
+ set x
+} {8C 1 {unknown encoding "jis0208"}}
+
+test encoding-3.1 {Tcl_GetEncodingName, NULL} {
+ set old [encoding system]
+ encoding system jis0208
+ set x [encoding system]
+ encoding system $old
+ set x
+} {jis0208}
+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 .
+ 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/tests/env.test b/tests/env.test
index c66812b..27656e4 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -6,13 +6,16 @@
#
# 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: env.test,v 1.3 1998/09/30 20:52:00 escoffon Exp $
+# RCS: @(#) $Id: env.test,v 1.4 1999/04/16 00:47:26 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
#
# These tests will run on any platform (and indeed crashed
@@ -38,17 +41,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::testConfig(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,7 +77,7 @@ 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 PURE_PROG_NAME DISPLAY SHLIB_PATH } {
lrem names $name
}
foreach p $names {
@@ -95,51 +105,135 @@ 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 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 temp [lindex [array names env] end]
+ set x env($temp)
+ set env($temp) a
+ set result [set env($temp)]
+ set env($temp) $x
+ 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} {knownBug} {
+ # 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,19 @@ foreach name [array names env2] {
set env($name) $env2($name)
}
+# cleanup
file delete printenv
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/error.test b/tests/error.test
index bd78987..45e8f1d 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -6,13 +6,16 @@
#
# 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: error.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: error.test,v 1.3 1999/04/16 00:47:26 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
proc foo {} {
global errorInfo
@@ -171,5 +174,19 @@ 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/tests/eval.test b/tests/eval.test
index 05eec40..6c53bb8 100644
--- a/tests/eval.test
+++ b/tests/eval.test
@@ -6,13 +6,16 @@
#
# 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: eval.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: eval.test,v 1.3 1999/04/16 00:47:26 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test eval-1.1 {single argument} {
eval {format 22}
@@ -53,3 +56,19 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
set a 1
error \"test error\"
}\""
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/event.test b/tests/event.test
index 118bfc1..d75c959 100644
--- a/tests/event.test
+++ b/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: event.test,v 1.3 1998/09/14 18:40:08 stanton Exp $
-
-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}}
+# RCS: @(#) $Id: event.test,v 1.4 1999/04/16 00:47:26 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+set ::tcltest::testConfig(testfilehandler) \
+ [expr {[info commands testfilehandler] != {}}]
+set ::tcltest::testConfig(testexithandler) \
+ [expr {[info commands testexithandler] != {}}]
+set ::tcltest::testConfig(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} {
@@ -453,115 +462,128 @@ 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/tests/exec.test b/tests/exec.test
index d365b5d..ceb677b 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -6,24 +6,21 @@
#
# 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: exec.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: exec.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-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} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
+# All tests require the "exec" command.
+# Skip them if exec is not defined.
+set ::tcltest::testConfig(execCommandExists) [expr {[info commands exec] != ""}]
+
set f [open echo w]
puts $f {
puts -nonewline [lindex $argv 0]
@@ -104,71 +101,71 @@ close $f
# Basic operations.
-test exec-1.1 {basic exec operation} {
+test exec-1.1 {basic exec operation} {execCommandExists stdio} {
exec $tcltest echo a b c
} "a b c"
-test exec-1.2 {pipelining} {
+test exec-1.2 {pipelining} {execCommandExists stdio} {
exec $tcltest echo a b c d | $tcltest cat | $tcltest cat
} "a b c d"
-test exec-1.3 {pipelining} {
+test exec-1.3 {pipelining} {execCommandExists stdio} {
set a [exec $tcltest echo a b c d | $tcltest cat | $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} {
+test exec-1.4 {long command lines} {execCommandExists stdio} {
exec $tcltest echo $arg
} $arg
set arg {}
# I/O redirection: input from Tcl command.
-test exec-2.1 {redirecting input from immediate source} {
+test exec-2.1 {redirecting input from immediate source} {execCommandExists stdio} {
exec $tcltest cat << "Sample text"
} {Sample text}
-test exec-2.2 {redirecting input from immediate source} {
+test exec-2.2 {redirecting input from immediate source} {execCommandExists stdio} {
exec << "Sample text" $tcltest cat | $tcltest cat
} {Sample text}
-test exec-2.3 {redirecting input from immediate source} {
+test exec-2.3 {redirecting input from immediate source} {execCommandExists stdio} {
exec $tcltest cat << "Sample text" | $tcltest cat
} {Sample text}
-test exec-2.4 {redirecting input from immediate source} {
+test exec-2.4 {redirecting input from immediate source} {execCommandExists stdio} {
exec $tcltest cat | $tcltest cat << "Sample text"
} {Sample text}
-test exec-2.5 {redirecting input from immediate source} {
+test exec-2.5 {redirecting input from immediate source} {execCommandExists stdio} {
exec $tcltest cat "<<Joined to arrows"
} {Joined to arrows}
# I/O redirection: output to file.
file delete gorp.file
-test exec-3.1 {redirecting output to file} {
+test exec-3.1 {redirecting output to file} {execCommandExists stdio} {
exec $tcltest echo "Some simple words" > gorp.file
exec $tcltest cat gorp.file
} "Some simple words"
-test exec-3.2 {redirecting output to file} {
+test exec-3.2 {redirecting output to file} {execCommandExists stdio} {
exec $tcltest echo "More simple words" | >gorp.file $tcltest cat | $tcltest cat
exec $tcltest cat gorp.file
} "More simple words"
-test exec-3.3 {redirecting output to file} {
+test exec-3.3 {redirecting output to file} {execCommandExists stdio} {
exec > gorp.file $tcltest echo "Different simple words" | $tcltest cat | $tcltest cat
exec $tcltest cat gorp.file
} "Different simple words"
-test exec-3.4 {redirecting output to file} {
+test exec-3.4 {redirecting output to file} {execCommandExists stdio} {
exec $tcltest echo "Some simple words" >gorp.file
exec $tcltest cat gorp.file
} "Some simple words"
-test exec-3.5 {redirecting output to file} {
+test exec-3.5 {redirecting output to file} {execCommandExists stdio} {
exec $tcltest echo "First line" >gorp.file
exec $tcltest echo "Second line" >> gorp.file
exec $tcltest cat gorp.file
} "First line\nSecond line"
-test exec-3.6 {redirecting output to file} {
+test exec-3.6 {redirecting output to file} {execCommandExists stdio} {
exec $tcltest echo "First line" >gorp.file
exec $tcltest echo "Second line" >>gorp.file
exec $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
@@ -182,20 +179,20 @@ test exec-3.7 {redirecting output to file} {
# I/O redirection: output and stderr to file.
file delete gorp.file
-test exec-4.1 {redirecting output and stderr to file} {
+test exec-4.1 {redirecting output and stderr to file} {execCommandExists stdio} {
exec $tcltest echo "test output" >& gorp.file
exec $tcltest cat gorp.file
} "test output"
-test exec-4.2 {redirecting output and stderr to file} {
+test exec-4.2 {redirecting output and stderr to file} {execCommandExists stdio} {
list [exec $tcltest sh -c "echo foo bar 1>&2" >&gorp.file] \
[exec $tcltest cat gorp.file]
} {{} {foo bar}}
-test exec-4.3 {redirecting output and stderr to file} {
+test exec-4.3 {redirecting output and stderr to file} {execCommandExists stdio} {
exec $tcltest echo "first line" > gorp.file
list [exec $tcltest sh -c "echo foo bar 1>&2" >>&gorp.file] \
[exec $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
@@ -205,7 +202,7 @@ test exec-4.4 {redirecting output and stderr to file} {
close $f
exec $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
@@ -219,28 +216,28 @@ test exec-4.5 {redirecting output and stderr to file} {
# I/O redirection: input from file.
exec $tcltest echo "Just a few thoughts" > gorp.file
-test exec-5.1 {redirecting input from file} {
+test exec-5.1 {redirecting input from file} {execCommandExists stdio} {
exec $tcltest cat < gorp.file
} {Just a few thoughts}
-test exec-5.2 {redirecting input from file} {
+test exec-5.2 {redirecting input from file} {execCommandExists stdio} {
exec $tcltest cat | $tcltest cat < gorp.file
} {Just a few thoughts}
-test exec-5.3 {redirecting input from file} {
+test exec-5.3 {redirecting input from file} {execCommandExists stdio} {
exec $tcltest cat < gorp.file | $tcltest cat
} {Just a few thoughts}
-test exec-5.4 {redirecting input from file} {
+test exec-5.4 {redirecting input from file} {execCommandExists stdio} {
exec < gorp.file $tcltest cat | $tcltest cat
} {Just a few thoughts}
-test exec-5.5 {redirecting input from file} {
+test exec-5.5 {redirecting input from file} {execCommandExists stdio} {
exec $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]
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]
close $f
@@ -249,25 +246,25 @@ test exec-5.7 {redirecting input from file} {
# I/O redirection: standard error through a pipeline.
-test exec-6.1 {redirecting stderr through a pipeline} {
+test exec-6.1 {redirecting stderr through a pipeline} {execCommandExists stdio} {
exec $tcltest sh -c "echo foo bar" |& $tcltest cat
} "foo bar"
-test exec-6.2 {redirecting stderr through a pipeline} {
+test exec-6.2 {redirecting stderr through a pipeline} {execCommandExists stdio} {
exec $tcltest sh -c "echo foo bar 1>&2" |& $tcltest cat
} "foo bar"
-test exec-6.3 {redirecting stderr through a pipeline} {
+test exec-6.3 {redirecting stderr through a pipeline} {execCommandExists stdio} {
exec $tcltest sh -c "echo foo bar 1>&2" \
|& $tcltest sh -c "echo second msg 1>&2 ; cat" |& $tcltest cat
} "second msg\nfoo bar"
# I/O redirection: combinations.
-catch {exec rm -f gorp.file2}
-test exec-7.1 {multiple I/O redirections} {
+file delete gorp.file2
+test exec-7.1 {multiple I/O redirections} {execCommandExists stdio} {
exec << "command input" > gorp.file2 $tcltest cat < gorp.file
exec $tcltest cat gorp.file2
} {Just a few thoughts}
-test exec-7.2 {multiple I/O redirections} {
+test exec-7.2 {multiple I/O redirections} {execCommandExists stdio} {
exec < gorp.file << "command input" $tcltest cat
} {command input}
@@ -278,125 +275,141 @@ 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} {
+test exec-8.1 {long input and output} {execCommandExists stdio} {
exec $tcltest cat << $a
} $a
+# More than 20 arguments to exec.
+
+test exec-8.1 {long input and output} {execCommandExists stdio} {
+ exec $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} {
+test exec-9.2 {commands returning errors} {execCommandExists stdio} {
string tolower [list [catch {exec $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} {
+test exec-9.3 {commands returning errors} {execCommandExists stdio} {
list [catch {exec $tcltest sleep 1 | $tcltest exit 43 | $tcltest sleep 1} msg] $msg
} {1 {child process exited abnormally}}
-test exec-9.4 {commands returning errors} {
+test exec-9.4 {commands returning errors} {execCommandExists stdio} {
list [catch {exec $tcltest exit 43 | $tcltest echo "foo bar"} msg] $msg
} {1 {foo bar
child process exited abnormally}}
-test exec-9.5 {commands returning errors} {
+test exec-9.5 {commands returning errors} {execCommandExists stdio} {
list [catch {exec gorp456 | $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} {
+test exec-9.6 {commands returning errors} {execCommandExists stdio} {
list [catch {exec $tcltest sh -c "echo error msg 1>&2"} msg] $msg
} {1 {error msg}}
-test exec-9.7 {commands returning errors} {
+test exec-9.7 {commands returning errors} {execCommandExists stdio} {
list [catch {exec $tcltest sh -c "echo error msg 1>&2" \
| $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 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} {
+test exec-10.21 {errors in exec invocation} {execCommandExists stdio} {
list [catch {exec $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} {
+test exec-11.1 {commands in background} {execCommandExists stdio} {
set x [lindex [time {exec $tcltest sleep 2 &}] 0]
expr $x<1000000
} 1
-test exec-11.2 {commands in background} {
+test exec-11.2 {commands in background} {execCommandExists stdio} {
list [catch {exec $tcltest echo a &b} msg] $msg
} {0 {a &b}}
-test exec-11.3 {commands in background} {
+test exec-11.3 {commands in background} {execCommandExists stdio} {
llength [exec $tcltest sleep 1 &]
} 1
-test exec-11.4 {commands in background} {
+test exec-11.4 {commands in background} {execCommandExists stdio} {
llength [exec $tcltest sleep 1 | $tcltest sleep 1 | $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
@@ -407,7 +420,8 @@ test exec-11.5 {commands in background} {
# they eventually die.
exec $tcltest sleep 3
-test exec-12.1 {reaping background processes} {unixOnly nonPortable} {
+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 +429,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 +438,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 +462,13 @@ test exec-12.3 {reaping background processes} {unixOnly nonPortable} {
# Make sure "errorCode" is set correctly.
-test exec-13.1 {setting errorCode variable} {
+test exec-13.1 {setting errorCode variable} {execCommandExists stdio} {
list [catch {exec $tcltest cat < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.2 {setting errorCode variable} {
+test exec-13.2 {setting errorCode variable} {execCommandExists stdio} {
list [catch {exec $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,39 +476,39 @@ test exec-13.3 {setting errorCode variable} {
# Switches before the first argument
-test exec-14.1 {-keepnewline switch} {
+test exec-14.1 {-keepnewline switch} {execCommandExists stdio} {
exec -keepnewline $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} {
+test exec-15.1 {standard error redirection} {execCommandExists stdio} {
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]
} {{} {foo bar}}
-test exec-15.2 {standard error redirection} {
+test exec-15.2 {standard error redirection} {execCommandExists stdio} {
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]
} {{} {biz baz} {foo bar}}
-test exec-15.3 {standard error redirection} {
+test exec-15.3 {standard error redirection} {execCommandExists stdio} {
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]
} {{} {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
@@ -503,19 +519,19 @@ test exec-15.4 {standard error redirection} {
} {Line 1
foo bar
Line 3}
-test exec-15.5 {standard error redirection} {
+test exec-15.5 {standard error redirection} {execCommandExists stdio} {
exec $tcltest echo "First line" > gorp.file
exec $tcltest sh -c "echo foo bar 1>&2" 2>> gorp.file
exec $tcltest cat gorp.file
} {First line
foo bar}
-test exec-15.6 {standard error redirection} {
+test exec-15.6 {standard error redirection} {execCommandExists stdio} {
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]
} {{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
@@ -525,7 +541,7 @@ test exec-16.1 {flush output before exec} {
} {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
@@ -536,7 +552,7 @@ test exec-16.2 {flush output before exec} {} {
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]
@@ -553,5 +569,21 @@ 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/tests/execute.test b/tests/execute.test
index b4ae4a4..aebe67b 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -9,13 +9,16 @@
# 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: execute.test,v 1.2 1998/09/14 18:40:08 stanton Exp $
+# RCS: @(#) $Id: execute.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
@@ -23,7 +26,420 @@ catch {unset x}
catch {unset y}
catch {unset msg}
-test execute-1.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
+set ::tcltest::testConfig(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 not tested
+# INST_LOAD_SCALAR4 not tested
+# 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-1.1 {TclExecuteByteCode, INST_ADD, op1 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {$x + 1}
+} 2
+test execute-1.2 {TclExecuteByteCode, INST_ADD, op1 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {$x + 1}
+} 2.0
+test execute-1.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-1.4 {TclExecuteByteCode, INST_ADD, op1 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {$x + 1}
+} 2
+test execute-1.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {$x + 1}
+} 2.0
+test execute-1.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-1.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {1 + $x}
+} 2
+test execute-1.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {1 + $x}
+} 2.0
+test execute-1.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-1.10 {TclExecuteByteCode, INST_ADD, op2 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {1 + $x}
+} 2
+test execute-1.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {1 + $x}
+} 2.0
+test execute-1.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-1.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {$x - 1}
+} 0
+test execute-1.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {$x - 1}
+} 0.0
+test execute-1.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-1.16 {TclExecuteByteCode, INST_SUB, op1 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {$x - 1}
+} 0
+test execute-1.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {$x - 1}
+} 0.0
+test execute-1.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-1.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
+ set x [testintobj set 0 1]
+ expr {1 - $x}
+} 0
+test execute-1.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
+ set x [testdoubleobj set 0 1]
+ expr {1 - $x}
+} 0.0
+test execute-1.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-1.22 {TclExecuteByteCode, INST_SUB, op2 is string int} {testobj} {
+ set x [teststringobj set 0 1]
+ expr {1 - $x}
+} 0
+test execute-1.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
+ set x [teststringobj set 0 1.0]
+ expr {1 - $x}
+} 0.0
+test execute-1.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-1.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {$x * 1}
+} 1
+test execute-1.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
+ set x [testdoubleobj set 1 2.0]
+ expr {$x * 1}
+} 2.0
+test execute-1.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-1.28 {TclExecuteByteCode, INST_MULT, op1 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {$x * 1}
+} 1
+test execute-1.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {$x * 1}
+} 1.0
+test execute-1.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-1.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {1 * $x}
+} 1
+test execute-1.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
+ set x [testdoubleobj set 1 2.0]
+ expr {1 * $x}
+} 2.0
+test execute-1.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-1.34 {TclExecuteByteCode, INST_MULT, op2 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {1 * $x}
+} 1
+test execute-1.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {1 * $x}
+} 1.0
+test execute-1.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-1.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {$x / 1}
+} 1
+test execute-1.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
+ set x [testdoubleobj set 1 2.0]
+ expr {$x / 1}
+} 2.0
+test execute-1.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-1.40 {TclExecuteByteCode, INST_DIV, op1 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {$x / 1}
+} 1
+test execute-1.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {$x / 1}
+} 1.0
+test execute-1.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-1.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {2 / $x}
+} 2
+test execute-1.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {2 / $x}
+} 2.0
+test execute-1.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-1.46 {TclExecuteByteCode, INST_DIV, op2 is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {2 / $x}
+} 2
+test execute-1.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {2 / $x}
+} 2.0
+test execute-1.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-1.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {+ $x}
+} 1
+test execute-1.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {+ $x}
+} 1.0
+test execute-1.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-1.52 {TclExecuteByteCode, INST_UPLUS, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {+ $x}
+} 1
+test execute-1.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {+ $x}
+} 1.0
+test execute-1.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-1.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {- $x}
+} -1
+test execute-1.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {- $x}
+} -1.0
+test execute-1.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-1.58 {TclExecuteByteCode, INST_UMINUS, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {- $x}
+} -1
+test execute-1.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {- $x}
+} -1.0
+test execute-1.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-1.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
+ set x [testintobj set 1 2]
+ expr {! $x}
+} 0
+test execute-1.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
+ set x [testintobj set 1 0]
+ expr {! $x}
+} 1
+test execute-1.63 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {! $x}
+} 0
+test execute-1.64 {TclExecuteByteCode, INST_LNOT, op is double} {testobj} {
+ set x [testdoubleobj set 1 0.0]
+ expr {! $x}
+} 1
+test execute-1.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-1.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-1.67 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {! $x}
+} 0
+test execute-1.68 {TclExecuteByteCode, INST_LNOT, op is string int} {testobj} {
+ set x [teststringobj set 1 0]
+ expr {! $x}
+} 1
+test execute-1.69 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
+ set x [teststringobj set 1 1.0]
+ expr {! $x}
+} 0
+test execute-1.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
+ set x [teststringobj set 1 0.0]
+ expr {! $x}
+} 1
+test execute-1.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-1.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
+ set x [testintobj set 1 1]
+ expr {$x}
+} 1
+test execute-1.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
+ set x [testdoubleobj set 1 1.0]
+ expr {$x}
+} 1.0
+test execute-1.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-1.75 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is string int} {testobj} {
+ set x [teststringobj set 1 1]
+ expr {$x}
+} 1
+test execute-1.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-1.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-2.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {unset x}
catch {unset y}
@@ -41,7 +457,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-2.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 +479,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-2.3 {Tcl_GetCommandFromObj, command never found} {
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename foo ""}
namespace eval test_ns_1 {
@@ -81,7 +497,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-3.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 +507,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-4.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
proc {} {} {}
proc { } {} {}
proc p {} {
@@ -103,6 +519,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 +528,21 @@ catch {rename { } ""}
catch {unset x}
catch {unset y}
catch {unset msg}
-concat {}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 0e50a06..aa5e035 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -2,19 +2,22 @@
#
# 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: expr-old.test,v 1.4 1998/11/02 23:04:13 stanton Exp $
+# RCS: @(#) $Id: expr-old.test,v 1.5 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
set gotT1 0
@@ -456,13 +459,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,10 +780,10 @@ 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}}
@@ -862,7 +865,7 @@ 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} {
@@ -871,7 +874,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} {
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 floating-point value as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
list [catch {expr 0289.1} msg] $msg
} {0 289.1}
@@ -927,3 +930,19 @@ 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/tests/expr.test b/tests/expr.test
index 2a5c860..7b0135a 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -5,13 +5,16 @@
# 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: expr.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: expr.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
set gotT1 0
@@ -88,7 +91,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 +101,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 +482,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 +518,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 +531,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 +548,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 +558,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} {
@@ -667,4 +667,43 @@ test expr-19.1 {expr and interpreter result object resetting} {
p
} 3
+# 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} {knownBug} {
+ 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}
+
+# cleanup
unset a
+::tcltest::cleanupTests
+return
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 2af1989..e1fc391 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -5,35 +5,46 @@
# 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.
#
-# RCS: @(#) $Id: fCmd.test,v 1.3 1998/12/04 04:18:20 hershey Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.4 1999/04/16 00:47:27 stanton Exp $
#
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 {$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."
- return
-}
-
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
@@ -77,8 +88,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}
}
}
}
@@ -91,35 +102,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::testConfig(fileSharing) 0
+set ::tcltest::testConfig(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::testConfig(fileSharing) 1
+ set ::tcltest::testConfig(notFileSharing) 0
}
file delete -force foo.dir
}
-set testConfig(xdev) 0
+set ::tcltest::testConfig(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::testConfig(xdev) 1
}
}
}
@@ -137,77 +140,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} {
+test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
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.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
@@ -218,17 +222,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} {
+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
@@ -239,60 +243,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'} {
+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
@@ -304,13 +310,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
@@ -322,19 +329,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
@@ -342,7 +349,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
@@ -351,7 +358,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
@@ -359,55 +366,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} {
+test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
list [catch {file delete ~nonexistantuser} msg] $msg
} {1 {user "nonexistantuser" doesn't exist}}
-test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {
+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
@@ -426,45 +433,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
@@ -472,28 +479,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
@@ -510,19 +515,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
@@ -530,7 +538,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]
@@ -539,7 +548,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
@@ -549,7 +559,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]
@@ -558,14 +569,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
@@ -573,65 +586,68 @@ 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} {
file mkdir td1
file attr td1 -perm 040000
set result [list [catch {file rename ~$user td1} msg] $msg]
@@ -639,7 +655,7 @@ test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} {unixOn
set result
} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
-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
@@ -649,11 +665,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
@@ -662,7 +678,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
@@ -670,7 +686,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
@@ -679,7 +695,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
@@ -688,7 +704,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
@@ -711,7 +727,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.
@@ -749,7 +765,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
@@ -767,7 +783,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
@@ -778,7 +794,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
@@ -796,7 +812,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"} {
@@ -811,34 +827,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
@@ -847,7 +865,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]
@@ -862,7 +880,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
@@ -885,7 +903,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]
@@ -910,7 +928,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
@@ -921,7 +940,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
@@ -932,7 +951,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
@@ -943,13 +963,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
@@ -959,7 +981,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
@@ -968,7 +990,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}]
@@ -981,7 +1003,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)
@@ -990,7 +1012,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
@@ -1000,7 +1022,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
@@ -1010,7 +1032,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 ]
@@ -1025,7 +1047,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
@@ -1041,7 +1063,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)
@@ -1050,7 +1072,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)
@@ -1062,13 +1084,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
@@ -1081,7 +1103,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
@@ -1095,7 +1117,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
@@ -1104,7 +1126,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
@@ -1113,7 +1135,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
@@ -1125,7 +1147,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
@@ -1134,7 +1156,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 ]
@@ -1147,7 +1170,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
@@ -1156,7 +1179,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
@@ -1165,7 +1188,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}]
@@ -1174,7 +1197,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}
@@ -1187,7 +1210,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
@@ -1197,7 +1220,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
@@ -1207,7 +1230,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 ]
@@ -1223,7 +1246,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
@@ -1239,7 +1262,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)
@@ -1248,7 +1271,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)
@@ -1261,13 +1284,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
@@ -1281,7 +1304,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
@@ -1295,7 +1318,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
@@ -1304,7 +1327,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]
@@ -1314,7 +1337,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
@@ -1328,7 +1351,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)
@@ -1340,7 +1363,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]
@@ -1348,7 +1371,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]]
@@ -1356,7 +1379,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
@@ -1367,7 +1390,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]
@@ -1376,7 +1400,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}]
@@ -1387,7 +1411,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]]
@@ -1395,7 +1419,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]
@@ -1405,21 +1429,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}]
@@ -1427,15 +1451,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)
@@ -1444,7 +1468,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
@@ -1453,7 +1477,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
@@ -1462,7 +1486,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
@@ -1478,7 +1502,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
@@ -1486,14 +1510,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
@@ -1503,7 +1527,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 ]
@@ -1511,7 +1535,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
@@ -1524,7 +1548,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
@@ -1544,7 +1569,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
@@ -1553,7 +1578,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
@@ -1566,7 +1591,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
@@ -1578,7 +1603,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
@@ -1593,7 +1618,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}]
@@ -1602,7 +1627,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}]
@@ -1611,7 +1637,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
@@ -1620,7 +1647,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}]
@@ -1629,7 +1657,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}]
@@ -1638,13 +1667,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]
@@ -1656,7 +1686,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
@@ -1668,7 +1699,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
@@ -1684,7 +1716,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
@@ -1697,7 +1730,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
@@ -1713,14 +1746,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
@@ -1731,7 +1764,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
@@ -1749,7 +1782,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
@@ -1764,7 +1798,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
@@ -1773,7 +1807,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
@@ -1782,7 +1816,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
@@ -1792,7 +1826,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
@@ -1802,7 +1837,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 ]
@@ -1817,7 +1852,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
@@ -1830,7 +1866,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
@@ -1840,7 +1876,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
@@ -1852,7 +1888,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
@@ -1861,7 +1897,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}]
@@ -1870,7 +1907,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}]
@@ -1879,7 +1916,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}]
@@ -1891,7 +1929,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]
@@ -1903,7 +1941,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
@@ -1912,7 +1950,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}]
@@ -1921,7 +1959,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]
@@ -1934,7 +1972,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]
@@ -1956,7 +1994,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]
@@ -1970,7 +2008,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
@@ -1982,7 +2020,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]
@@ -1992,7 +2031,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
@@ -2002,7 +2042,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]
@@ -2017,7 +2058,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
@@ -2032,7 +2073,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
@@ -2048,7 +2089,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
@@ -2063,9 +2104,6 @@ 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]
@@ -2082,27 +2120,45 @@ 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::testConfig(foundGroup) 0
+ catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ set ::tcltest::testConfig(foundGroup) 1
}
+} else {
+ set ::tcltest::testConfig(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/tests/fileName.test b/tests/fileName.test
index 287033f..426fd10 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -5,17 +5,21 @@
# 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: fileName.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: fileName.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +1032,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}
@@ -1103,10 +1107,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]}
@@ -1171,13 +1171,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,12 +1214,9 @@ 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} {
+test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
lsort [glob g*/*.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]
} {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
@@ -1229,30 +1226,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 +1270,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}}
@@ -1308,142 +1293,137 @@ test filename-14.24 {slash globbing} {pcOnly} {
} /
# 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::testConfig(sharedCdrive) 0
+} else {
+ set ::tcltest::testConfig(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/tests/for-old.test b/tests/for-old.test
index c78ff2c..b2e2d39 100644
--- a/tests/for-old.test
+++ b/tests/for-old.test
@@ -12,9 +12,11 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: for-old.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: for-old.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Check "for" and its use of continue and break.
@@ -64,3 +66,19 @@ test for-old-1.9 {for tests} {
}
set a
} {1 2 3}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/for.test b/tests/for.test
index 609ca78..4503c0b 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -9,9 +9,11 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: for.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: for.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Basic "for" operation.
@@ -582,11 +584,169 @@ test for-4.1 {break must reset the interp result} {
set j
} {}
-# Check "for" and computed command names.
-
-test for-5.1 {for and computed command names} {
- set j 0
+# Basic "for" operation with computed command names.
+test for-5.1 {for cmd with computed command names: missing initial command} {
set z for
- $z {set i 0} {$i<10} {incr i} {set j $i}
- set j
-} 9
+ list [catch {$z} msg] $msg
+} {1 {wrong # args: should be "for start test next command"}}
+test for-5.2 {for cmd with computed command names: error in initial command} {
+ set z for
+ list [catch {$z {set}} msg] $msg $errorInfo
+} {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
+ while executing
+"$z {set}"}}
+test for-5.3 {for cmd with computed command names: missing test expression} {
+ set z for
+ catch {$z {set i 0}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-5.4 {for cmd with computed command names: error in test expression} {
+ set z for
+ catch {$z {set i 0} {$i<}} msg
+ set errorInfo
+} {wrong # args: should be "for start test next command"
+ while executing
+"$z {set i 0} {$i<}"}
+test for-5.5 {for cmd with computed command names: test expression is enclosed in quotes} {
+ set z for
+ set i 0
+ $z {} "$i > 5" {incr i} {}
+} {}
+test for-5.6 {for cmd with computed command names: missing "next" command} {
+ set z for
+ catch {$z {set i 0} {$i < 5}} msg
+ set msg
+} {wrong # args: should be "for start test next command"}
+test for-5.7 {for cmd with computed command names: missing command body} {
+ 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-5.8 {for cmd with computed command names: 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-5.9 {for cmd with computed command names: 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-5.10 {for cmd with computed command names: 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-5.11 {for cmd with computed command names: 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-5.12 {for cmd with computed command names: 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-5.13 {for cmd with computed command names: 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-5.14 {for cmd with computed command names: for command result} {
+ set z for
+ set a [$z {set i 0} {$i < 5} {incr i} {}]
+ set a
+} {}
+test for-5.15 {for cmd with computed command names: for command result} {
+ set z for
+ set a [$z {set i 0} {$i < 5} {incr i} {if $i==3 break}]
+ set a
+} {}
+
+# Test for incorrect "double evaluation" semantics
+
+test for-6.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-6.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}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/foreach.test b/tests/foreach.test
index 7d7b8b5..66e626e 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -10,9 +10,11 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: foreach.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: foreach.test,v 1.3 1999/04/16 00:47:27 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {unset a}
catch {unset x}
@@ -208,5 +210,33 @@ 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/tests/format.test b/tests/format.test
index e3d8be0..2b52187 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -5,14 +5,16 @@
# 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: format.test,v 1.3 1998/11/02 23:04:13 stanton Exp $
+# RCS: @(#) $Id: format.test,v 1.4 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# 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 +80,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 +421,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 +432,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 +441,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 +450,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,10 +459,10 @@ 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}
@@ -424,15 +472,28 @@ 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/tests/get.test b/tests/get.test
index bf746aa..261cf19 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -5,13 +5,16 @@
# 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: get.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: get.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test get-1.1 {Tcl_GetInt procedure} {
set x 44
@@ -39,39 +42,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 +92,19 @@ 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/tests/history.test b/tests/history.test
index 4417049..c7f7d20 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -6,20 +6,24 @@
#
# 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: history.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
+# RCS: @(#) $Id: history.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
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 +213,18 @@ 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/tests/http.test b/tests/http.test
index c4ddbf8..752e3a2 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -6,21 +6,24 @@
#
# 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: http.test,v 1.3 1998/11/03 02:00:54 welch Exp $
+# RCS: @(#) $Id: http.test,v 1.4 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
if {[catch {package require http 2.0}]} {
if {[info exist http2]} {
- catch {puts stderr "Cannot load http 2.0 package"}
+ catch {puts "Cannot load http 2.0 package"}
return
} else {
- catch {puts stderr "Running http 2.0 tests in slave interp"}
+ catch {puts "Running http 2.0 tests in slave interp"}
set interp [interp create http2]
$interp eval [list set http2 "running"]
$interp eval [list source [info script]]
@@ -29,160 +32,34 @@ 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 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
-
- 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"
- 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 httpdFile [file join $::tcltest::testsDir 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
@@ -412,6 +289,27 @@ test http-6.1 {http::ProxyRequired} {
<h2>GET http://$url</h2>
</body></html>"
+# cleanup
unset url
unset port
-close $listen
+if {[info exists httpthread]} {
+ testthread send -async $httpthread {
+ testthread exit
+ }
+} else {
+ close $listen
+}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/httpd b/tests/httpd
new file mode 100644
index 0000000..1531964
--- /dev/null
+++ b/tests/httpd
@@ -0,0 +1,148 @@
+#
+# The httpd_ procedures implement a stub http server.
+#
+# 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.
+#
+# SCCS: @(#) httpd 1.2 98/02/20 14:51:59
+
+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
+ close $sock
+}
+
+# Respond to the query.
+
+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>
+ }
+
+ 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
+}
+
+
diff --git a/tests/httpold.test b/tests/httpold.test
index f6d5fe0..5d874f6 100644
--- a/tests/httpold.test
+++ b/tests/httpold.test
@@ -6,25 +6,29 @@
#
# 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: httpold.test,v 1.2 1998/09/14 18:40:09 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+# RCS: @(#) $Id: httpold.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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
}
}
@@ -36,7 +40,7 @@ proc httpd_init {{port 8015}} {
proc httpd_log {args} {
global httpLog
if {[info exists httpLog] && $httpLog} {
- puts stderr "httpd: [join $args { }]"
+ puts "httpd: [join $args { }]"
}
}
array set httpdErrors {
@@ -145,6 +149,14 @@ proc httpdRespond { sock } {
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
}
@@ -171,8 +183,9 @@ proc httpdRespond { sock } {
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 +389,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 +421,21 @@ test http-6.1 {httpProxyRequired} {
<h2>GET http://$url</h2>
</body></html>"
+# cleanup
unset url
unset port
close $listen
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/if-old.test b/tests/if-old.test
index 024cc53..d21b568 100644
--- a/tests/if-old.test
+++ b/tests/if-old.test
@@ -8,13 +8,16 @@
#
# 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-old.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: if-old.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test if-old-1.1 {taking proper branch} {
set a {}
@@ -154,3 +157,19 @@ 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/tests/if.test b/tests/if.test
index 8da1a0d..99e7c37 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -5,13 +5,16 @@
# 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.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: if.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Basic "if" operation.
@@ -495,11 +498,594 @@ 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/tests/incr-old.test b/tests/incr-old.test
index cafe208..64b2012 100644
--- a/tests/incr-old.test
+++ b/tests/incr-old.test
@@ -8,13 +8,16 @@
#
# 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: incr-old.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: incr-old.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {unset x}
@@ -86,4 +89,18 @@ 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/tests/incr.test b/tests/incr.test
index 99ded82..02ccf37 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -5,13 +5,16 @@
# 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: incr.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: incr.test,v 1.3 1999/04/16 00:47:28 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Basic "incr" operation.
@@ -238,9 +241,273 @@ test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
# 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/tests/indexObj.test b/tests/indexObj.test
index d4ae81a..979e5a8 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -3,19 +3,21 @@
# 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: indexObj.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: indexObj.test,v 1.3 1999/04/16 00:47:29 stanton Exp $
-if {[info procs test] != "test"} {
- source defs
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
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 +68,19 @@ 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/tests/info.test b/tests/info.test
index b059fc8..4522520 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -5,14 +5,29 @@
# 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: info.test,v 1.5 1998/11/11 02:39:56 welch Exp $
+# RCS: @(#) $Id: info.test,v 1.6 1999/04/16 00:47:29 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# 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"}
+}
-if {[string compare test [info procs test]] == 1} then {source defs}
test info-1.1 {info args option} {
proc t1 {a bbb c} {return foo}
@@ -38,6 +53,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,6 +71,13 @@ 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"}}
# "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
@@ -59,7 +88,7 @@ test info-3.1 {info cmdcount option} {
set z [info cm]
expr $z-$x
} 1
-test info-3.2 {info body option} {
+test info-3.2 {info cmdcount option} {
list [catch {info cmdcount 1} msg] $msg
} {1 {wrong # args: should be "info cmdcount"}}
@@ -93,152 +122,17 @@ 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"
-} 1
-test info-5.3 {info complete option} {
- info complete "abc def"
-} 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 {[]]]}
+ info complete abc
} 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"
+test info-5.2 {info complete option} {
+ info complete "\{abcd "
} 0
-test info-5.48 {info complete option} {
- info complete "set x [binary format H 00]; puts hi"
+test info-5.3 {info complete option} {
+ info complete {# Comment should be complete command}
} 1
-test info-5.49 {info complete option} {
- info complete "set x [binary format H 00]; \{"
-} 0
test info-6.1 {info default option} {
proc t1 {a b {c d} {e "long default value"}} {}
@@ -288,6 +182,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 +317,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,31 +400,34 @@ 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-16.1 {info script option} {
list [catch {info script x} msg] $msg
} {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 +498,20 @@ 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/tests/init.test b/tests/init.test
index 2cec460..4172606 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -5,14 +5,16 @@
# 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: init.test,v 1.2 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: init.test,v 1.3 1999/04/16 00:47:29 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -58,25 +60,27 @@ 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 source [file join $::tcltest::testsDir defs.tcl]]
interp eval $testInterp {
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +133,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
@@ -145,5 +149,19 @@ test init-3.0 {random stuff in the auto_index, should still work} {
}
+# cleanup
interp delete $testInterp
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/interp.test b/tests/interp.test
index da0c433..817ef99 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -5,21 +5,23 @@
# 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: interp.test,v 1.6 1999/02/03 02:58:41 stanton Exp $
+# RCS: @(#) $Id: interp.test,v 1.7 1999/04/16 00:47:29 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# 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 +42,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 +86,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 +102,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 +165,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 +188,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
@@ -1598,7 +1598,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 +1606,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 +1666,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 +1682,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}
@@ -1933,31 +1933,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
- interp eval a {proc ret {code} {return -code $code $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 return -code $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.2 {result code transmission : interp eval indirect} {
+ # retcode == 2 == return is special
+ catch {interp delete a}
+ interp create a
+ 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 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.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 +2031,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}
+
+# 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.3 {errorInfo transmission : regular interps} {
+test interp-26.7 {errorInfo transmission: regular interps} {
set interp [interp create];
proc MyError {secret} {
return -code error "msg"
@@ -1993,14 +2061,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 +2083,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} {
@@ -2163,7 +2232,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 {
@@ -2264,6 +2333,28 @@ test interp-30.1 {deletion of aliases inside namespaces} {
$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/tests/io.test b/tests/io.test
index 51dc6ae..620bc48 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7,13 +7,16 @@
#
# 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: io.test,v 1.6 1998/11/02 23:04:14 stanton Exp $
+# RCS: @(#) $Id: io.test,v 1.7 1999/04/16 00:47:29 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
if {"[info commands testchannel]" != "testchannel"} {
puts "Skipping io tests. This application does not seem to have the"
@@ -21,6 +24,8 @@ if {"[info commands testchannel]" != "testchannel"} {
return
}
+::tcltest::saveState
+
removeFile test1
removeFile pipe
@@ -35,95 +40,1544 @@ 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
}
}
-}
-close $f
+ vwait forever
+} cat
+
+set thisScript [file join [pwd] [info script]]
# 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.1 {unsupported0 command} {knownBug} {
+ removeFile test1
+ set f1 [open iocmd.test]
+ set f2 [open test1 w]
+ unsupported0 $f1 $f2
+ close $f1
+ catch {close $f2}
+ set s1 [file size $thisScript]
+ set s2 [file size test1]
+ set x ok
+ if {"$s1" != "$s2"} {
+ set x broken
+ }
+ set x
+} ok
+test io-1.2 {unsupported0 command} {knownBug} {
+ removeFile test1
+ set f1 [open $thisScript]
+ set f2 [open test1 w]
+ unsupported0 $f1 $f2 40
+ close $f1
+ close $f2
+ file size test1
+} 40
+test io-1.3 {unsupported0 command} {knownBug} {
+ removeFile test1
+ set f1 [open $thisScript]
+ set f2 [open test1 w]
+ unsupported0 $f1 $f2 -1
+ close $f1
+ close $f2
+ set x ok
+ set s1 [file size $thisScript]
+ set s2 [file size test1]
+ if {$s1 != $s2} {
+ set x broken
+ }
+ set x
+} ok
+test io-1.4 {unsupported0 command} {knownBug unixOrPc} {
+ removeFile pipe
+ removeFile test1
+ set f1 [open pipe w]
+ puts $f1 {puts ready}
+ puts $f1 {gets stdin}
+ puts $f1 {set f1 [open $thisScript 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}
+
+proc contents {file} {
+ set f [open $file]
+ fconfigure $f -translation binary
+ set a [read $f]
+ close $f
+ return $a
+}
+
+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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 +1587,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 +1595,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 +1604,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
@@ -179,7 +1633,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
@@ -207,7 +1661,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 +1671,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 +1681,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 +1691,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]
@@ -255,7 +1709,7 @@ test io-1.8 {reuse of stdio special channels} {unixOnly} {
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]
@@ -274,8 +1728,11 @@ test io-1.9 {reuse of stdio special channels} {stdio} {
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,7 +1741,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.
-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
@@ -296,7 +1753,7 @@ test io-2.1 {GetChannelTable, DeleteChannelTable on std handles} {
lappend l [expr [testchannel refcount stdin] - $l1]
set l
} {0 1 0}
-test io-2.2 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {
set l1 [testchannel refcount stdout]
eof stdin
interp create x
@@ -308,7 +1765,7 @@ test io-2.2 {GetChannelTable, DeleteChannelTable on std handles} {
lappend l [expr [testchannel refcount stdout] - $l1]
set l
} {0 1 0}
-test io-2.3 {GetChannelTable, DeleteChannelTable on std handles} {
+test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {
set l1 [testchannel refcount stderr]
eof stdin
interp create x
@@ -320,7 +1777,8 @@ test io-2.3 {GetChannelTable, DeleteChannelTable on std handles} {
lappend l [expr [testchannel refcount stderr] - $l1]
set l
} {0 1 0}
-test io-2.4 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
+
+test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {
removeFile test1
set l ""
set f [open test1 w]
@@ -334,7 +1792,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]
@@ -355,7 +1813,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]
@@ -374,20 +1832,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 ""
@@ -402,27 +1861,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 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"
@@ -435,7 +1946,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
@@ -451,9 +1962,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 << 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
@@ -461,7 +1981,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 {}
@@ -474,7 +1994,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 {}
@@ -485,7 +2005,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 {}
@@ -501,7 +2021,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 {}
@@ -515,7 +2036,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]
@@ -546,7 +2068,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
}
@@ -554,7 +2076,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
@@ -567,7 +2089,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
@@ -582,7 +2104,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]
@@ -613,9 +2136,6 @@ test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc as
set f [open "|[list $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
@@ -630,7 +2150,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]]
@@ -643,7 +2163,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 {
@@ -657,13 +2177,10 @@ test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
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 {}
@@ -671,7 +2188,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 {}
@@ -679,7 +2196,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 {}
@@ -693,7 +2210,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 {}
@@ -707,7 +2224,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 {}
@@ -721,7 +2238,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 {}
@@ -738,7 +2256,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
@@ -758,34 +2276,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]
@@ -800,17 +2318,17 @@ test io-6.12 {Tcl_Write on a pipe} {stdio} {
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]
@@ -827,19 +2345,19 @@ test io-6.13 {Tcl_Write to a pipe, line buffered} {stdio} {
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"
@@ -851,7 +2369,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
@@ -861,14 +2379,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} {
+test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
set fd [open "|[list $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
@@ -880,7 +2398,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]
@@ -899,7 +2417,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 {}
@@ -917,7 +2435,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 {}
@@ -928,14 +2446,14 @@ 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]}
@@ -949,7 +2467,7 @@ test io-6.21 {Tcl_Flush to pipe} {stdio} {
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 {
@@ -972,7 +2490,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 {
@@ -992,7 +2510,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"
@@ -1006,9 +2524,8 @@ 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]
puts $f "Line 1"
@@ -1019,10 +2536,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
@@ -1030,7 +2545,7 @@ 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}
@@ -1058,7 +2573,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 {}
@@ -1068,7 +2583,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 {}
@@ -1076,7 +2591,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 {}
@@ -1084,7 +2599,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]
@@ -1100,7 +2615,7 @@ 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
@@ -1110,17 +2625,18 @@ test io-6.31 {Tcl_Write, background flush} {stdio} {
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]
@@ -1137,7 +2653,7 @@ 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
@@ -1147,17 +2663,17 @@ test io-6.32 {Tcl_Write, background flush to slow reader} {stdio && asyncPipeClo
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]
@@ -1172,12 +2688,8 @@ test io-6.33 {Tcl_Flush, implicit flush on exit} {stdio} {
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
@@ -1213,7 +2725,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
@@ -1254,7 +2769,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
@@ -1266,7 +2781,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
@@ -1278,7 +2793,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
@@ -1290,7 +2805,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
@@ -1302,7 +2817,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
@@ -1314,7 +2829,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
@@ -1326,7 +2841,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
@@ -1338,7 +2853,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
@@ -1350,7 +2865,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
@@ -1362,7 +2877,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
@@ -1378,7 +2893,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
@@ -1394,7 +2909,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
@@ -1411,7 +2926,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
@@ -1428,7 +2943,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
@@ -1445,7 +2960,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
@@ -1461,7 +2976,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
@@ -1477,7 +2992,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
@@ -1493,7 +3008,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
@@ -1513,7 +3028,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
@@ -1533,7 +3048,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 {}
@@ -1555,7 +3070,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 {}
@@ -1566,14 +3081,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 {}
@@ -1584,14 +3099,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
@@ -1605,7 +3120,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
@@ -1619,7 +3134,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
@@ -1633,7 +3148,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
@@ -1647,7 +3162,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
@@ -1661,7 +3176,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
@@ -1678,7 +3193,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
@@ -1695,7 +3210,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
@@ -1712,7 +3227,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
@@ -1729,7 +3244,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
@@ -1747,7 +3262,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
@@ -1766,8 +3281,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
@@ -1786,8 +3301,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
@@ -1807,7 +3322,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
@@ -1827,7 +3342,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
@@ -1847,7 +3362,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
@@ -1867,7 +3382,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
@@ -1887,7 +3402,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
@@ -1907,7 +3422,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
@@ -1919,7 +3434,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
@@ -1938,7 +3453,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
@@ -1957,7 +3472,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
@@ -1975,7 +3490,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
@@ -1994,7 +3509,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
@@ -2014,7 +3529,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
@@ -2033,7 +3548,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
@@ -2052,7 +3567,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
@@ -2070,7 +3585,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 {}
@@ -2092,7 +3607,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 {}
@@ -2114,7 +3629,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 {}
@@ -2136,7 +3651,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
@@ -2154,7 +3669,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
@@ -2172,7 +3687,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 {}
@@ -2190,7 +3705,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 {}
@@ -2208,7 +3723,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 {}
@@ -2226,7 +3741,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 {}
@@ -2244,7 +3759,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
@@ -2255,7 +3770,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
@@ -2263,13 +3778,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
@@ -2281,24 +3796,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]
@@ -2306,7 +3821,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]
@@ -2315,7 +3830,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
@@ -2323,11 +3838,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]
@@ -2335,11 +3850,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]
@@ -2348,11 +3863,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
@@ -2360,11 +3875,11 @@ 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]}
@@ -2376,7 +3891,7 @@ test io-9.10 {Tcl_Read from a pipe} {stdio} {
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]}
@@ -2395,7 +3910,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
@@ -2407,7 +3922,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
@@ -2419,7 +3934,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"
@@ -2432,7 +3947,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"
@@ -2445,7 +3960,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"
@@ -2460,7 +3975,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"
@@ -2470,23 +3985,23 @@ 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]}
@@ -2498,11 +4013,11 @@ test io-10.3 {Tcl_Gets from pipe} {stdio} {
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"
@@ -2516,13 +4031,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"
@@ -2538,7 +4053,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"
@@ -2550,7 +4065,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 ""
@@ -2563,7 +4078,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 ""
@@ -2576,7 +4091,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 ""
@@ -2592,14 +4107,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 {}
@@ -2612,7 +4127,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 {}
@@ -2625,7 +4140,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 {}
@@ -2638,7 +4153,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 {}
@@ -2652,7 +4167,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 {}
@@ -2667,7 +4182,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 {}
@@ -2683,14 +4198,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} {
+test io-34.8 {Tcl_Seek on pipes: not supported} {stdio} {
set f1 [open "|[list $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 {}
@@ -2713,7 +4228,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
@@ -2727,7 +4242,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
@@ -2738,7 +4253,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
@@ -2755,14 +4270,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 {}
@@ -2775,7 +4290,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 {}
@@ -2790,13 +4305,13 @@ 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} {
+test io-34.16 {Tcl_tell on pipe: always -1} {stdio} {
set f1 [open "|[list $tcltest]" r+]
set c [tell $f1]
close $f1
set c
} -1
-test io-11.17 {Tcl_Tell on pipe: always -1} {stdio} {
+test io-34.17 {Tcl_Tell on pipe: always -1} {stdio} {
set f1 [open "|[list $tcltest]" r+]
puts $f1 {puts hello}
flush $f1
@@ -2805,7 +4320,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 {}
@@ -2825,7 +4340,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"
@@ -2836,7 +4351,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
@@ -2854,7 +4369,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
@@ -2873,7 +4388,7 @@ 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}
@@ -2891,7 +4406,7 @@ 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}
@@ -2913,7 +4428,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
@@ -2925,7 +4440,7 @@ 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 {
@@ -2939,7 +4454,7 @@ test io-12.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
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
@@ -2953,7 +4468,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
@@ -2967,7 +4482,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
@@ -2981,7 +4496,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
@@ -2995,7 +4510,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
@@ -3009,7 +4524,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
@@ -3023,7 +4538,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 {}
@@ -3038,7 +4553,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 {}
@@ -3053,7 +4568,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 {}
@@ -3068,7 +4583,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 {}
@@ -3083,7 +4598,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 {}
@@ -3098,7 +4613,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 {}
@@ -3116,7 +4631,7 @@ 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} {
+test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio} {
set f1 [open "|[list $tcltest]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
@@ -3135,7 +4650,7 @@ 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} {
+test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio} {
set f1 [open "|[list $tcltest]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
@@ -3149,7 +4664,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
@@ -3165,7 +4680,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]
@@ -3182,7 +4697,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
@@ -3199,7 +4714,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]
@@ -3220,7 +4735,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
@@ -3230,7 +4745,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
@@ -3246,13 +4761,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]
@@ -3274,7 +4789,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]
@@ -3284,14 +4799,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
@@ -3299,7 +4814,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 ""
@@ -3315,7 +4830,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 ""
@@ -3325,7 +4840,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
@@ -3335,7 +4850,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
@@ -3349,7 +4864,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 ""
@@ -3369,7 +4884,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
@@ -3385,13 +4900,15 @@ 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+]
@@ -3399,10 +4916,14 @@ test io-16.10 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
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
@@ -3415,7 +4936,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
@@ -3423,7 +4944,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
@@ -3431,7 +4952,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
@@ -3439,12 +4960,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 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]
@@ -3452,12 +5027,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]
@@ -3465,12 +5040,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]
@@ -3478,12 +5053,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]
@@ -3492,7 +5067,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
@@ -3507,7 +5082,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
@@ -3519,7 +5094,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::testConfig(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}]
@@ -3527,7 +5107,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 {}
@@ -3542,7 +5122,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 {}
@@ -3563,7 +5143,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
@@ -3572,7 +5152,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 {}
@@ -3580,7 +5160,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
@@ -3593,7 +5173,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"
@@ -3603,7 +5183,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"
@@ -3615,15 +5195,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 {}
@@ -3635,11 +5215,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"
@@ -3649,7 +5229,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
@@ -3658,7 +5238,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]
@@ -3666,19 +5246,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}}
@@ -3688,10 +5268,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]
@@ -3702,18 +5282,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]
@@ -3724,7 +5312,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"
@@ -3739,7 +5327,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 {}
}
@@ -3748,7 +5336,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
@@ -3760,7 +5348,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
@@ -3775,7 +5363,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
@@ -3786,7 +5374,7 @@ 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} {
+test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs} {
set f4 [open "|[list $tcltest cat << foo]" r]
fileevent $f4 readable {
if {[gets $f4 line] < 0} {
@@ -3806,13 +5394,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]\""
@@ -3824,7 +5409,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 {
@@ -3841,7 +5426,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]
@@ -3867,7 +5452,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]
@@ -3882,7 +5467,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
@@ -3891,7 +5476,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
@@ -3905,7 +5490,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]
@@ -3924,7 +5509,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]
@@ -3945,7 +5530,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]
@@ -3966,7 +5551,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
@@ -3982,7 +5567,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
@@ -3995,7 +5580,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
@@ -4013,7 +5598,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
@@ -4038,7 +5623,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
@@ -4064,7 +5649,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
@@ -4108,7 +5693,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
@@ -4133,7 +5718,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
@@ -4158,7 +5743,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
@@ -4183,7 +5768,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
@@ -4208,7 +5793,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
@@ -4233,7 +5818,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
@@ -4258,7 +5843,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
@@ -4283,7 +5868,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
@@ -4308,7 +5893,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
@@ -4333,7 +5918,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
@@ -4358,7 +5943,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
@@ -4383,7 +5968,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
@@ -4409,7 +5994,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
@@ -4438,7 +6023,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
@@ -4461,7 +6046,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
@@ -4482,7 +6067,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
@@ -4503,7 +6088,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
@@ -4522,7 +6107,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
@@ -4538,7 +6123,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
@@ -4556,7 +6141,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
@@ -4582,7 +6167,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
@@ -4606,7 +6191,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
@@ -4639,7 +6224,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
@@ -4681,7 +6266,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} {
@@ -4719,9 +6304,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
@@ -4729,11 +6314,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
@@ -4741,9 +6326,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
@@ -4751,16 +6336,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
@@ -4770,9 +6355,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
@@ -4780,39 +6365,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
@@ -4821,19 +6406,19 @@ 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+]
fconfigure $f1 -translation lf
@@ -4848,9 +6433,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
@@ -4860,9 +6445,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
@@ -4871,14 +6456,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]
@@ -4908,8 +6493,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
}
@@ -4944,6 +6529,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"
@@ -4956,24 +6542,22 @@ 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}
@@ -4991,7 +6575,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.
@@ -5043,36 +6627,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
@@ -5088,9 +6676,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"
@@ -5106,7 +6697,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
@@ -5126,12 +6717,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}
@@ -5147,12 +6738,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}
@@ -5169,7 +6760,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"
@@ -5195,20 +6786,24 @@ 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
+}
+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/tests/ioCmd.test b/tests/ioCmd.test
index 8de4456..1937c5d 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -7,13 +7,16 @@
#
# 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: ioCmd.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.3 1999/04/16 00:47:29 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
removeFile test1
removeFile pipe
@@ -158,7 +161,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
@@ -205,31 +208,31 @@ 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"}}
@@ -250,7 +253,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 {} {
@@ -293,9 +296,8 @@ test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unixOnly} {
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
+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;
@@ -313,6 +315,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 +492,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 +503,26 @@ 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/tests/ioUtil.test b/tests/ioUtil.test
index dd254fd..5bb8c35 100644
--- a/tests/ioUtil.test
+++ b/tests/ioUtil.test
@@ -1,16 +1,18 @@
-# This file (iOUtil.test) tests the hookable TclStat(), TclAccess(),
+# 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 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: ioUtil.test,v 1.5 1998/09/14 18:40:10 stanton Exp $
+# RCS: @(#) $Id: ioUtil.test,v 1.6 1999/04/16 00:47:29 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
set unsetScript {
catch {unset testStat1(size)}
@@ -18,7 +20,7 @@ set unsetScript {
catch {unset testStat3(size)}
}
-test stat-1.1 {TclStat: Check that none of the test procs are there.} {
+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
@@ -29,7 +31,7 @@ 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 stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
+test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
catch {teststatproc insert TclpStat} err1
teststatproc insert TestStatProc1
teststatproc insert TestStatProc2
@@ -37,7 +39,7 @@ test stat-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {
set err1
} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
-test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {
+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
@@ -47,12 +49,12 @@ test stat-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {
eval $unsetScript
-test stat-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} {
+test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletedable.} {
catch {teststatproc delete TclpStat} err2
set err2
} {"TclpStat": could not be deleteed}
-test stat-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {
+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.
@@ -66,7 +68,7 @@ test stat-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {
eval $unsetScript
-test stat-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {
+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.
@@ -80,7 +82,7 @@ test stat-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {
eval $unsetScript
-test stat-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {
+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.
@@ -94,7 +96,7 @@ test stat-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone
eval $unsetScript
-test stat-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {
+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.
@@ -120,7 +122,7 @@ 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 access-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {
+test ioUtil-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {
catch {testaccessproc insert TclpAccess} err1
testaccessproc insert TestAccessProc1
testaccessproc insert TestAccessProc2
@@ -128,14 +130,14 @@ test access-1.2 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.}
set err1
} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
-test access-1.3 {TclAccess: Use "file access ?" to invoke each procedure.} {
+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 access-1.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletedable.} {
+test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletedable.} {
catch {testaccessproc delete TclpAccess} err2
set err2
} {"TclpAccess": could not be deleteed}
@@ -152,7 +154,7 @@ test accesst-1.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {
list $res1 $err3 $res2
} {1 0 1}
-test access-1.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {
+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.
@@ -164,7 +166,7 @@ test access-1.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {
list $err4 $err5 $res3
} {0 0 1}
-test access-1.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {
+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.
@@ -176,7 +178,7 @@ test access-1.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are
list $err6 $err7 $err8
} {0 0 0}
-test access-1.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {
+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.
@@ -188,7 +190,7 @@ test access-1.8 {TclAccessDeleteProc: Verify that all procs have been deleted.}
} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
}
-test openfilechannel-1.1 {TclOpenFileChannel: Check that none of the test procs are there.} {
+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
@@ -202,7 +204,7 @@ 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 openfilechannel-1.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {
+test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {
catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
testopenfilechannelproc insert TestOpenFileChannelProc1
testopenfilechannelproc insert TestOpenFileChannelProc2
@@ -210,7 +212,7 @@ test openfilechannel-1.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpe
set err1
} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
-test openfilechannel-1.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {
+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]
@@ -228,7 +230,7 @@ test openfilechannel-1.3 {TclOpenFileChannel: Use "file openfilechannel ?" to in
set err
} {}
-test openfilechannel-1.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} {
+test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletedable.} {
catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
set err2
} {"TclpOpenFileChannel": could not be deleteed}
@@ -254,7 +256,7 @@ test openfilechannelt-1.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenF
set err3
} {}
-test openfilechannel-1.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {
+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.
@@ -273,7 +275,7 @@ test openfilechannel-1.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFi
set err4
} {}
-test openfilechannel-1.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {
+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.
@@ -287,7 +289,7 @@ test openfilechannel-1.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure
set err5
} {1}
-test openfilechannel-1.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {
+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.
@@ -298,3 +300,19 @@ test openfilechannel-1.8 {TclOpenFileChannelDeleteProc: Verify that all procs ha
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/tests/join.test b/tests/join.test
index 1c41d53..6194c7d 100644
--- a/tests/join.test
+++ b/tests/join.test
@@ -6,13 +6,16 @@
#
# 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: join.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: join.test,v 1.3 1999/04/16 00:47:29 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test join-1.1 {basic join commands} {
join {a b c} xyz
@@ -45,4 +48,18 @@ 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/tests/lindex.test b/tests/lindex.test
index a4596c5..c7e5fb8 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -6,13 +6,16 @@
#
# 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: lindex.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: lindex.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test lindex-1.1 {basic tests} {
lindex {a b c} 0} a
@@ -72,3 +75,19 @@ 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/tests/link.test b/tests/link.test
index 0878c5f..4ea079c 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -6,20 +6,24 @@
#
# 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: link.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: link.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +232,24 @@ 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/tests/linsert.test b/tests/linsert.test
index 2ccce4b..5c54d92 100644
--- a/tests/linsert.test
+++ b/tests/linsert.test
@@ -6,13 +6,16 @@
#
# 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: linsert.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: linsert.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {unset lis}
catch {rename p ""}
@@ -101,5 +104,20 @@ 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/tests/list.test b/tests/list.test
index 06a7e2f..fa83038 100644
--- a/tests/list.test
+++ b/tests/list.test
@@ -6,13 +6,16 @@
#
# 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: list.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: list.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# First, a bunch of individual tests
@@ -105,3 +108,19 @@ 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/tests/listObj.test b/tests/listObj.test
index 5ea2ad4..2c9e58e 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -6,20 +6,24 @@
# 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: listObj.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: listObj.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +31,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 +181,19 @@ test listobj-8.1 {SetListFromAny} {
test listobj-9.1 {UpdateStringOfList} {
string length [list foo\x00help]
} 8
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/llength.test b/tests/llength.test
index cf09b23..40c0d73 100644
--- a/tests/llength.test
+++ b/tests/llength.test
@@ -6,13 +6,16 @@
#
# 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: llength.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: llength.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test llength-1.1 {length of list} {
llength {a b c d}
@@ -33,3 +36,19 @@ 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/tests/load.test b/tests/load.test
index d5b27ae..8bbfb98 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -5,79 +5,92 @@
# 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: load.test,v 1.3 1998/11/12 05:54:21 welch Exp $
+# RCS: @(#) $Id: load.test,v 1.4 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# 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::testConfig($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::testConfig($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 +103,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 +128,67 @@ 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/tests/lrange.test b/tests/lrange.test
index 1691eb4..4132969 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -6,13 +6,16 @@
#
# 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: lrange.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: lrange.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
@@ -81,3 +84,19 @@ test lrange-2.5 {error conditions} {
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/tests/lreplace.test b/tests/lreplace.test
index 0aed5d5..d0743eb 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -6,13 +6,16 @@
#
# 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: lreplace.test,v 1.2 1998/09/14 18:40:11 stanton Exp $
+# RCS: @(#) $Id: lreplace.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test lreplace-1.1 {lreplace command} {
lreplace {1 2 3 4 5} 0 0 a
@@ -128,4 +131,19 @@ 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/tests/lsearch.test b/tests/lsearch.test
index 8d066c4..498607b 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -6,13 +6,16 @@
#
# 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: lsearch.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: lsearch.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
@@ -45,7 +48,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
@@ -84,3 +87,19 @@ 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/tests/macFCmd.test b/tests/macFCmd.test
index 17d6f89..bbb5df8 100644
--- a/tests/macFCmd.test
+++ b/tests/macFCmd.test
@@ -5,164 +5,204 @@
# 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: macFCmd.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: macFCmd.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
#
-if {$tcl_platform(platform) != "macintosh"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-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::testConfig(fileSharing) 0
+ set ::tcltest::testConfig(notFileSharing) 1
} else {
- set testConfig(fileSharing) 1
- set testConfig(notFileSharing) 0
+ set ::tcltest::testConfig(fileSharing) 1
+ set ::tcltest::testConfig(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} {
+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} {
+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} {
+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} {
+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/tests/misc.test b/tests/misc.test
index 6106ce8..67c2216 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -7,13 +7,16 @@
#
# 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: misc.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: misc.test,v 1.3 1999/04/16 00:47:30 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test misc-1.1 {error in variable ref. in command in array reference} {
proc tstProc {} {
@@ -48,4 +51,25 @@ 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/tests/msgcat.test b/tests/msgcat.test
new file mode 100644
index 0000000..b9410e2
--- /dev/null
+++ b/tests/msgcat.test
@@ -0,0 +1,318 @@
+# 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: msgcat.test,v 1.2 1999/04/16 00:47:31 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+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]
+
+#
+# Test the various permutations of mclocale
+# and mcpreferences.
+#
+
+test msgcat-1.1 {::msgcat::mclocale default} {
+ ::msgcat::mclocale
+} {c}
+test msgcat-1.2 {::msgcat::mcpreferences, single element} {
+ ::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
+foreach l $locales {
+ file delete [string tolower [file join msgdir $l.msg]]
+}
+
+# Clean out the msg catalogs
+::msgcat::mclocale $oldlocale
+file delete msgdir
+
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 7efa6c1..d8a736e 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -9,13 +9,16 @@
#
# 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: namespace-old.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: namespace-old.test,v 1.3 1999/04/16 00:47:31 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -842,3 +845,19 @@ 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/tests/namespace.test b/tests/namespace.test
index 93add66..54f1149 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -6,13 +6,16 @@
# 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: namespace.test,v 1.3 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: namespace.test,v 1.4 1999/04/16 00:47:31 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Clear out any namespaces called test_ns_*
catch {eval namespace delete [namespace children :: test_ns_*]}
@@ -1090,8 +1093,23 @@ 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/tests/obj.test b/tests/obj.test
index b4b7672..ce7738d 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -6,20 +6,24 @@
# 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: obj.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: obj.test,v 1.3 1999/04/16 00:47:31 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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 +87,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 +143,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 +151,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 +160,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 +211,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 +258,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 +266,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 +275,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 +359,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 +367,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 +376,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 +472,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 +480,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 +489,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 +528,19 @@ 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/tests/opt.test b/tests/opt.test
index ce79827..3ca62f2 100644
--- a/tests/opt.test
+++ b/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,19 @@
#
# 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: opt.test,v 1.3 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: opt.test,v 1.4 1999/04/16 00:47:31 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# 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
@@ -253,7 +256,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 +265,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 +273,18 @@ test opt-11.2 {default value for args} {
set args
} {a b c}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/osa.test b/tests/osa.test
index d7de348..4b061cf 100644
--- a/tests/osa.test
+++ b/tests/osa.test
@@ -5,32 +5,43 @@
# 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: osa.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: osa.test,v 1.3 1999/04/16 00:47:31 stanton Exp $
-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} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-test osa-1.1 {Tcl_OSAComponentCmd} {
+# Only run the test if we can load the AppleScript command
+set ::tcltest::testConfig(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/tests/parse.test b/tests/parse.test
index 7019b7a..1f36063 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -1,556 +1,743 @@
-# 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: parse.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+# RCS: @(#) $Id: parse.test,v 1.3 1999/04/16 00:47:31 stanton Exp $
-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} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-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}
-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-11.1 {Tcl_Eval2, 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_Eval2, error while parsing} {
+ list [catch {testevalex {concat "abc}} msg] $msg
+} {1 {missing "}}
+test parse-11.3 {Tcl_Eval2, 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_Eval2, 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_Eval2, exceptional return} {
+ list [catch {testevalex {break}} msg] $msg
+} {3 {}}
+test parse-11.6 {Tcl_Eval2, 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_Eval2, multiple commands in script} {
+ list [testevalex {set a b; set c d}] $a $c
+} {d b d}
+test parse-11.8 {Tcl_Eval2, multiple commands in script} {
+ list [testevalex {
+ set a b
+ set c d
+ }] $a $c
+} {d b d}
+test parse-11.9 {Tcl_Eval2, 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 {}
+} {}
+
+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
+
+# cleanup
+catch {unset a}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
new file mode 100644
index 0000000..e454321
--- /dev/null
+++ b/tests/parseExpr.test
@@ -0,0 +1,637 @@
+# 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: parseExpr.test,v 1.2 1999/04/16 00:47:31 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# 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 {syntax error in expression "0999"}}
+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/tests/parseOld.test b/tests/parseOld.test
new file mode 100644
index 0000000..3f799d6
--- /dev/null
+++ b/tests/parseOld.test
@@ -0,0 +1,546 @@
+# 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: parseOld.test,v 1.2 1999/04/16 00:47:32 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+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 {array variable substitution} {
+ set b a$()
+ set b
+} {a$()}
+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}
+test parseOld-10.14 {syntax errors} {
+ list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+} {1 {missing )} {missing )
+ while compiling
+"$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/tests/pid.test b/tests/pid.test
index c93237f..3f8275b 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -6,21 +6,25 @@
#
# 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: pid.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: pid.test,v 1.3 1999/04/16 00:47:32 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# 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 +52,19 @@ 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/tests/pkg.test b/tests/pkg.test
index d379eb8..02ffc14 100644
--- a/tests/pkg.test
+++ b/tests/pkg.test
@@ -5,23 +5,24 @@
# 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: pkg.test,v 1.3 1999/03/10 05:52:51 stanton Exp $
+# RCS: @(#) $Id: pkg.test,v 1.4 1999/04/16 00:47:32 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# 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 source [file join $::tcltest::testsDir defs.tcl]]
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 +484,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, present, 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.
@@ -632,4 +633,20 @@ package unknown $oldPkgUnknown
concat
}
+
+# cleanup
interp delete $i
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/pkg/import.tcl b/tests/pkg/import.tcl
new file mode 100644
index 0000000..e7196f5
--- /dev/null
+++ b/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/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 5b14989..e49cf25 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -5,20 +5,33 @@
# 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: pkgMkIndex.test,v 1.5 1999/03/31 22:37:17 welch Exp $
+# RCS: @(#) $Id: pkgMkIndex.test,v 1.6 1999/04/16 00:47:32 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
+if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {
+ set origPkgDir [file join $::tcltest::testsDir pkg]
+ set newPkgDir [file join $::tcltest::workingDir pkg]
+ if {![catch {file copy $origPkgDir $newPkgDir}]} {
+ set removePkgDir 1
+ }
+ if {![catch {file copy "${origPkgDir}1" "${newPkgDir}1"}]} {
+ set removePkg1Dir 1
+ }
+}
# 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::workingDir pkg1]
namespace eval pkgtest {
# Namespace for procs we can discard
@@ -316,20 +329,19 @@ test pkgMkIndex-9.1 {circular packages} {
pkgtest::runIndex pkg 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]} {
+# 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::testConfig($dll) [file exists $x]
+
+test pkgMkIndex-10.1 {package in DLL and script} $dll {
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)"
-}
+ pkgtest::runIndex pkg 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 -load Pkg* -- pkg pkga[info sharedlibextension]
+} {0 {}}
# Tolerate "namespace import" at the global scope
@@ -337,11 +349,27 @@ test pkgMkIndex-11.1 {conflicting namespace imports} {
pkgtest::runIndex pkg import.tcl
} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}
-
-#
# cleanup
-#
-if {![info exist TESTS]} {
- file delete [file join pkg pkgIndex.tcl]
- namespace delete pkgtest
+namespace delete pkgtest
+cd $::tcltest::workingDir
+if {[info exists removePkgDir]} {
+ # strange error deleting the pkg dir only once--needs be done twice!
+ catch {file delete -force $newPkgDir}
+ catch {file delete -force $newPkgDir}
+}
+if {[info exists removePkg1Dir]} {
+ catch {file delete -force "${newPkgDir}1"}
}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/platform.test b/tests/platform.test
index f5273b2..b81103c 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -11,10 +11,29 @@
#
# RCS: @(#)
-if {[info procs test] != "test"} {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test platform-1.1 {TclpSetVariables: tcl_platform} {
- lsort [array names tcl_platform]
-} {byteOrder machine os osVersion platform}
+ interp create i
+ i eval {catch {unset tcl_platform(debug)}}
+ 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/tests/proc-old.test b/tests/proc-old.test
index 07310f4..a57e147 100644
--- a/tests/proc-old.test
+++ b/tests/proc-old.test
@@ -9,13 +9,16 @@
#
# 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: proc-old.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: proc-old.test,v 1.3 1999/04/16 00:47:32 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {rename t1 ""}
catch {rename foo ""}
@@ -501,5 +504,20 @@ 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/tests/proc.test b/tests/proc.test
index 478d15f..60f5d8e 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -8,13 +8,16 @@
# 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: proc.test,v 1.3 1998/10/05 22:32:11 escoffon Exp $
+# RCS: @(#) $Id: proc.test,v 1.4 1999/04/16 00:47:32 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {eval namespace delete [namespace children :: test_ns_*]}
catch {rename p ""}
@@ -165,6 +168,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 +293,20 @@ 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/tests/pwd.test b/tests/pwd.test
index ae827f9..0656b63 100644
--- a/tests/pwd.test
+++ b/tests/pwd.test
@@ -6,13 +6,16 @@
#
# 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: pwd.test,v 1.2 1998/09/14 18:40:12 stanton Exp $
+# RCS: @(#) $Id: pwd.test,v 1.3 1999/04/16 00:47:32 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test pwd-1.1 {simple pwd} {
catch pwd
@@ -20,3 +23,19 @@ 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/tests/reg.test b/tests/reg.test
new file mode 100644
index 0000000..de20e33
--- /dev/null
+++ b/tests/reg.test
@@ -0,0 +1,905 @@
+# 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.
+#
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: reg.test,v 1.2 1999/04/16 00:47:33 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# All tests require the testregexp command, return if this
+# command doesn't exist
+
+set ::tcltest::testConfig(testregexp) \
+ [expr {[info commands testregexp] != {}}]
+
+# 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 for compile error expected, f for match failure expected, m
+# for a successful match, and i for a successful match with -indices (used
+# in checking things like nonparticipating subexpressions). There is also
+# a "doing" procedure which sets up title and major test number for each
+# block of tests, and an "xx" procedure which ignores its arguments and
+# arranges for the next invocation of "doing" to announce that some tests
+# were bypassed (which is better than just commenting them out).
+
+# 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 presents 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.
+
+# 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
+# % 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 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
+#
+# 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
+# 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(U) "REG_UPBOTCH"
+set infonameorder "RHQBAUEPSMLNI" ;# 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\
+ $major, `$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
+
+ # 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
+
+ # 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
+proc matchexpected {opts testid flags re target args} {
+ global prefix description ask
+
+ # 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
+ set nsub 0 ;# unsigned value cannot be -1
+ }
+ set ecmd [concat $ecmd $names]
+ set erun "list \[$ecmd\] $refs"
+ set result [concat [list 1] $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"]]
+}
+
+# test temporarily unimplemented
+proc xx {args} {
+ global testbypassed
+
+ incr testbypassed
+}
+
+
+
+# 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 regexp-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 {R[1P} {a(b*)c\1} abbcbb abbcbb bb
+m 2 {R[1P} {a(b*)c\1} ac ac ""
+f 3 {R[1P} {a(b*)c\1} abbcb
+m 4 {R[1P} {a(b*)\1} abbcbb abb b
+m 5 {R[1P} {a(b|bb)\1} abbcbb abb b
+m 6 {R[1P} {a([bc])\1} abb abb b
+f 7 {R[1P} {a([bc])\1} abc
+m 8 {R[1P} {a([bc])\1} abcabb abb b
+f 9 {R[1P} {a([bc])*\1} abc
+f 10 {R[1P} {a([bc])\1} abB
+m 11 {iR[1P} {a([bc])\1} abB abB b
+m 12 {R[1P} {a([bc])\1+} abbb abbb b
+m 13 {QR[1P} "a(\[bc])\\1{3,4}" abbbb abbbb b
+f 14 {QR[1P} "a(\[bc])\\1{3,4}" abbb
+m 15 {R[1P} {a([bc])\1*} abbb abbb b
+m 16 {R[1P} {a([bc])\1*} ab ab b
+m 17 {R[2P} {a([bc])(\1*)} ab ab b ""
+e 18 - {a((b)\1)} ESUBREG
+e 19 - {a(b)c\2} ESUBREG
+m 20 {bR[1} {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
+# currently disabled because the fake MCCE we use for testing is unavailable
+xx m 1 &+L {a[c]e} ace ace
+xx f 2 &+I {a[c]h} ach
+xx m 3 &+L {a[[.ch.]]} ach ach
+xx f 4 &+L {a[[.ch.]]} ace
+xx m 5 &+L {a[c[.ch.]]} ac ac
+xx m 6 &+L {a[c[.ch.]]} ace ac
+xx m 7 &+L {a[c[.ch.]]} ache ach
+xx f 8 &+L {a[^c]e} ace
+xx m 9 &+L {a[^c]e} abe abe
+xx m 10 &+L {a[^c]e} ache ache
+xx f 11 &+L {a[^[.ch.]]} ach
+xx m 12 &+L {a[^[.ch.]]} ace ac
+xx m 13 &+L {a[^[.ch.]]} ac ac
+xx m 14 &+L {a[^[.ch.]]} abe ab
+xx f 15 &+L {a[^c[.ch.]]} ach
+xx f 16 &+L {a[^c[.ch.]]} ace
+xx f 17 &+L {a[^c[.ch.]]} ac
+xx m 18 &+L {a[^c[.ch.]]} abe ab
+xx m 19 &+L {a[^b]} ac ac
+xx m 20 &+L {a[^b]} ace ac
+xx m 21 &+L {a[^b]} ach ach
+xx 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 P ab+? abb ab
+m 2 P ab+?c abbc abbc
+m 3 P ab*? abb a
+m 4 P ab*?c abbc abbc
+m 5 P ab?? ab a
+m 6 P ab??c abc abc
+m 7 PQ "ab{2,4}?" abbbb abb
+m 8 PQ "ab{2,4}?c" abbbbc abbbbc
+
+
+
+doing 25 "mixed quantifiers"
+xx to be done, actually
+xx should include |
+
+
+
+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 "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
+
+
+
+doing 0 "flush" ;# to flush any leftover complaints
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
diff --git a/tests/regexp.test b/tests/regexp.test
index f5354fb..611a780 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -5,14 +5,17 @@
# 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: regexp.test,v 1.2 1998/09/14 18:40:13 stanton Exp $
+# RCS: @(#) $Id: regexp.test,v 1.3 1999/04/16 00:47:33 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {unset foo}
test regexp-1.1 {basic regexp operation} {
@@ -30,6 +33,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 +79,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 +135,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,20 +189,21 @@ 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 -indices, -nocase, -about, -expanded, -line, -linestop, -lineanchor, 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)"}}
@@ -244,6 +260,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
@@ -312,7 +334,45 @@ test regexp-10.5 {regsub errors} {
} {1 {bad switch "-gorp": must be -all, -nocase, or --}}
test regexp-10.6 {regsub errors} {
list [catch {regsub -nocase a( b c d} msg] $msg
-} {1 {couldn't compile regular expression pattern: unmatched ()}}
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-10.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.1 {Tcl_RegExpExec: large number of subexpressions} {
+ 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-12.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 ""
+ for {set i 1} {$i<200} {incr i} {
+ append filedata $line
+ }
+ for {set i 1} {$i<10} {incr i} {
+ regsub -all "BEGIN_TABLE " $filedata "" newfiledata
+ }
+ set x done
+} {done}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/registry.test b/tests/registry.test
index b78beff..773f964 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -8,150 +8,159 @@
# 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: registry.test,v 1.4 1999/02/02 23:01:42 stanton Exp $
+# RCS: @(#) $Id: registry.test,v 1.5 1999/04/16 00:47:33 stanton Exp $
-if {$tcl_platform(platform) != "windows"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-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::testConfig(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, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-2.2 {DeleteKey: bad key} {
+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 +169,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 +223,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 +232,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 +470,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 +492,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 +502,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, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.4 {ParseKeyName: bad keys} {
+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, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.5 {ParseKeyName: bad keys} {
+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, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.7 {ParseKeyName: bad keys} {
+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, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.8 {ParseKeyName: null keys} {
+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 +555,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 +564,38 @@ 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/tests/remote.tcl b/tests/remote.tcl
index 9d27cdc..005f2df 100644
--- a/tests/remote.tcl
+++ b/tests/remote.tcl
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: remote.tcl,v 1.2 1998/09/14 18:40:13 stanton Exp $
+# RCS: @(#) $Id: remote.tcl,v 1.3 1999/04/16 00:47:33 stanton Exp $
# Initialize message delimitor
@@ -159,3 +159,14 @@ if {[catch {set serverSocket \
} else {
vwait __server_wait_variable__
}
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/rename.test b/tests/rename.test
index 5f0d733..14cdf05 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -6,13 +6,16 @@
#
# 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: rename.test,v 1.2 1998/09/14 18:40:13 stanton Exp $
+# RCS: @(#) $Id: rename.test,v 1.3 1999/04/16 00:47:33 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Must eliminate the "unknown" command while the test is running,
# especially if the test is being run in a program with its
@@ -163,10 +166,21 @@ test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile
set msg
} {called "incr" with too many arguments}
+# cleanup
catch {rename incr {}}
catch {rename incr.old incr}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
-# Make the file return an empty string (cleaner.).
-set x ""
diff --git a/tests/resource.test b/tests/resource.test
index 91e93a4..b5f341a 100644
--- a/tests/resource.test
+++ b/tests/resource.test
@@ -5,45 +5,44 @@
# 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: resource.test,v 1.3 1998/11/10 06:54:20 jingham Exp $
+# RCS: @(#) $Id: resource.test,v 1.4 1999/04/16 00:47:33 stanton Exp $
-# Only run this test on Macintosh systems
-if {$tcl_platform(platform) != "macintosh"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-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 +52,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 +62,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 +101,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 +115,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 +149,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 +167,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 +176,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 +185,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 +194,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 +207,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 +221,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 +230,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 +263,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 +272,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 +280,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 +288,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 +298,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 +307,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 +321,44 @@ 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/tests/result.test b/tests/result.test
new file mode 100644
index 0000000..3f77fdc
--- /dev/null
+++ b/tests/result.test
@@ -0,0 +1,102 @@
+# 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} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# Some tests require the testsaveresult command
+
+set ::tcltest::testConfig(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/tests/safe.test b/tests/safe.test
index 74cac8d..5149c59 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -5,13 +5,16 @@
# 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: safe.test,v 1.4 1998/11/03 01:02:28 stanton Exp $
+# RCS: @(#) $Id: safe.test,v 1.5 1999/04/16 00:47:33 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
foreach i [interp slaves] {
interp delete $i
@@ -81,7 +84,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 +170,16 @@ 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 r
} {byteOrder platform}
# more test should be added to check that hostname, nameofexecutable,
@@ -434,3 +442,86 @@ 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/tests/scan.test b/tests/scan.test
index ecbd79a..aa86a4d 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -6,52 +6,354 @@
#
# 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: scan.test,v 1.3 1998/11/02 23:04:14 stanton Exp $
+# RCS: @(#) $Id: scan.test,v 1.4 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
-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-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} {
+ list [catch {scan {} %d} msg] $msg
+} {1 {different numbers of variable names and field specifiers}}
+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 assigend by any conversion specifiers}}
+test scan-3.9 {ValidateFormat} {
+ list [catch {scan {} {%2$s} x y} msg] $msg
+} {1 {variable is not assigend 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} {
+ list [catch {scan string format} msg] $msg
+} {0 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} {
+ scan { abc def } { abc def }
+} 0
+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 +362,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 +384,203 @@ 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 assigend 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
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/security.test b/tests/security.test
new file mode 100644
index 0000000..d75696a
--- /dev/null
+++ b/tests/security.test
@@ -0,0 +1,53 @@
+# 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: security.test,v 1.2 1999/04/16 00:47:34 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+# 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/tests/set-old.test b/tests/set-old.test
index bd93730..08e2cd1 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -8,13 +8,16 @@
#
# 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: set-old.test,v 1.3 1998/09/14 18:40:13 stanton Exp $
+# RCS: @(#) $Id: set-old.test,v 1.4 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
proc ignore args {}
@@ -786,9 +789,23 @@ 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/tests/set.test b/tests/set.test
index 5d762b4..7ffeb75 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -5,13 +5,16 @@
# 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: set.test,v 1.2 1998/09/14 18:40:13 stanton Exp $
+# RCS: @(#) $Id: set.test,v 1.3 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
catch {unset x}
catch {unset i}
@@ -27,7 +30,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
@@ -226,8 +229,271 @@ 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}
-return ""
+
+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}
+catch {unset z}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/socket.test b/tests/socket.test
index 5ff563a..249dc5e 100644
--- a/tests/socket.test
+++ b/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-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: socket.test,v 1.7 1999/04/16 00:47:34 stanton Exp $
+
# Running socket tests with a remote server:
# ------------------------------------------
#
@@ -58,15 +61,16 @@
# 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: socket.test,v 1.6 1998/12/04 01:01:55 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
-if {$testConfig(socket) == 0} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
+# Some tests require the testthread command
+
+set ::tcltest::testConfig(testthread) \
+ [expr {[info commands testthread] != {}}]
+
#
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
@@ -93,7 +97,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 +119,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 $remoteFile \
-serverIsSilent \
-port $remoteServerPort \
-address $remoteServerIP]" \
@@ -145,10 +147,12 @@ if {$doTestsWithRemoteServer} {
}
}
+# Some tests are run only if we are doing testing against a remote server.
+set ::tcltest::testConfig(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 +196,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 {
@@ -259,7 +263,7 @@ test socket-2.1 {tcp connection} {stdio} {
close $f
set f [open "|[list $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 +279,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"
@@ -296,9 +300,9 @@ test socket-2.2 {tcp connection with client port specified} {stdio} {
set f [open "|[list $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 +313,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"
@@ -329,7 +333,7 @@ test socket-2.3 {tcp connection with client interface specified} {stdio} {
close $f
set f [open "|[list $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 +344,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]"
@@ -360,7 +364,7 @@ test socket-2.4 {tcp connection with server interface specified} {stdio} {
close $f
set f [open "|[list $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 +375,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]"
@@ -391,7 +395,7 @@ test socket-2.5 {tcp connection with redundant server port} {stdio} {
close $f
set f [open "|[list $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 +406,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 +416,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
@@ -441,20 +445,19 @@ test socket-2.7 {echo server, one line} {stdio} {
close $f
set f [open "|[list $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,26 +481,27 @@ test socket-2.8 {echo server, loop 50 times, single connection} {stdio} {
after cancel $timer
close $f
puts "done $i"
- }
- close $f
+ } script
set f [open "|[list $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]
gets $f
@@ -509,7 +513,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 +536,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,7 +544,7 @@ 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
@@ -561,7 +565,7 @@ test socket-2.11 {detecting new data} {
} {one {} 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 {
@@ -579,7 +583,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 {
@@ -615,11 +619,11 @@ test socket-3.2 {server with several clients} {stdio} {
close $f
set f [open "|[list $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 +641,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
@@ -699,7 +703,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 +713,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 +722,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 +730,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,12 +740,12 @@ 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+]
@@ -765,7 +765,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 {
@@ -782,7 +782,7 @@ test socket-7.1 {testing socket specific options} {stdio} {
close $f
set f [open "|[list $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 +791,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 {
@@ -808,7 +808,7 @@ test socket-7.2 {testing socket specific options} {stdio} {
close $f
set f [open "|[list $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 +817,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 +840,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 +857,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 +887,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 +919,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 +967,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 +1007,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 +1035,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 +1059,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 +1069,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 +1093,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 +1127,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 +1138,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 +1174,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 +1200,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 +1222,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 +1236,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 +1275,7 @@ 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} {
@@ -1317,7 +1308,8 @@ test socket-11.12 {testing EOF stickyness} {
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,7 +1362,8 @@ test socket-11.13 {testing async write, async flush, async close} {
set count
} 65566
-test socket-12.1 {testing inheritance of server sockets} {
+test socket-12.1 {testing inheritance of server sockets} \
+ {socket doTestsWithRemoteServer} {
removeFile script1
removeFile script2
@@ -1410,7 +1403,7 @@ test socket-12.1 {testing inheritance of server sockets} {
# If we can still connect to the server, the socket got inherited.
- if {[catch {socket localhost 2828} msg]} {
+ if {[catch {socket 127.0.0.1 2828} msg]} {
set x {server socket was not inherited}
} else {
close $msg
@@ -1421,7 +1414,8 @@ test socket-12.1 {testing inheritance of server sockets} {
removeFile script2
set x
} {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} {
+test socket-12.2 {testing inheritance of client sockets} \
+ {socket doTestsWithRemoteServer} {
removeFile script1
removeFile script2
@@ -1442,7 +1436,7 @@ test socket-12.2 {testing inheritance of client sockets} {
set f [open script2 w]
puts $f [list set tcltest $tcltest]
puts $f {
- set f [socket localhost 2829]
+ set f [socket 127.0.0.1 2829]
exec $tcltest script1 &
puts $f testing
flush $f
@@ -1506,7 +1500,8 @@ test socket-12.2 {testing inheritance of client sockets} {
removeFile script2
set x
} {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} {
+test socket-12.3 {testing inheritance of accepted sockets} \
+ {socket doTestsWithRemoteServer} {
removeFile script1
removeFile script2
@@ -1539,7 +1534,7 @@ test socket-12.3 {testing inheritance of accepted sockets} {
after 1000 set ok_to_proceed 1
vwait ok_to_proceed
- set f [socket localhost 2930]
+ set f [socket 127.0.0.1 2930]
fconfigure $f -buffering full -blocking 0
fileevent $f readable [list getdata $f]
@@ -1581,13 +1576,94 @@ test socket-12.3 {testing inheritance of accepted sockets} {
set x
} {accepted socket was not inherited}
+test socket-13.1 {Testing use of shared socket between two threads} \
+ {socket testthread} {
+
+ set mainthread [testthread names]
+ proc ThreadReap {} {
+ global mainthread
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != $mainthread} {
+ catch {testthread send -async $tid {testthread exit}}
+ update
+ }
+ }
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+ }
+
+ removeFile script
+ set f [open script w]
+ puts $f {
+ 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
+ }
+ close $f
+
+ # create a thread
+ set serverthread [testthread create { source script } ]
+ update
+
+
+ set s [socket 127.0.0.1 2828]
+ fconfigure $s -buffering line
+ catch {
+ puts $s "hello"
+ gets $s result
+ }
+ close $s
+ update
+
+ after 2000
+ ThreadReap
+
+ set result
+
+} hello
+
+# 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/tests/source.test b/tests/source.test
index 590188f..74a3589 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -6,13 +6,16 @@
#
# 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: source.test,v 1.2 1998/09/14 18:40:13 stanton Exp $
+# RCS: @(#) $Id: source.test,v 1.3 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test source-1.1 {source command} {
set x "old x value"
@@ -30,23 +33,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 +131,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 +179,19 @@ 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/tests/split.test b/tests/split.test
index 8674db8..fc78e84 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -6,13 +6,16 @@
#
# 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: split.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: split.test,v 1.3 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test split-1.1 {basic split commands} {
split "a\n b\t\r c\n "
@@ -63,3 +66,19 @@ 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/tests/stack.test b/tests/stack.test
index 2499220..1e62788 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -4,14 +4,16 @@
# 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: stack.test,v 1.1 1998/09/30 20:52:01 escoffon Exp $
+# RCS: @(#) $Id: stack.test,v 1.2 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
# Note that a failure in this test results in a crash of the executable.
@@ -21,3 +23,19 @@ 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/tests/string.test b/tests/string.test
index b7b58ab..641b8c2 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -6,13 +6,16 @@
#
# 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: string.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: string.test,v 1.3 1999/04/16 00:47:34 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test string-1.1 {string compare} {
string compare abcde abdef
@@ -289,7 +292,7 @@ test string-10.4 {string trimright errors} {
} {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}}
+} {1 {bad option "trimg": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
test string-11.1 {string tolower} {
string tolower ABCDeF
@@ -350,7 +353,7 @@ test string-13.8 {string wordend} {
test string-14.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}}
+} {1 {ambiguous option "word": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
test string-14.2 {string wordstart} {
list [catch {string wordstart a} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
@@ -378,7 +381,23 @@ test string-14.9 {string wordend} {
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}}
+} {1 {bad option "gorp": must be compare, first, index, last, length, match, range, tolower, toupper, totitle, 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 ...?"}}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/stringObj.test b/tests/stringObj.test
index bcfbe0c..33100e5 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -7,20 +7,24 @@
# 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: stringObj.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: stringObj.test,v 1.3 1999/04/16 00:47:35 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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]
@@ -187,3 +191,19 @@ test stringObj-8.1 {DupStringInternalRep procedure} {
} {5 10 5 5 abcde}
testobj freeallvars
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/subst.test b/tests/subst.test
index 3378756..51546d2 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -6,13 +6,16 @@
#
# 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: subst.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: subst.test,v 1.3 1999/04/16 00:47:35 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test subst-1.1 {basics} {
list [catch {subst} msg] $msg
@@ -84,7 +87,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 +107,19 @@ 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/tests/switch.test b/tests/switch.test
index 4d1f4a8..cdbfc61 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -6,13 +6,16 @@
#
# 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: switch.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: switch.test,v 1.3 1999/04/16 00:47:35 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test switch-1.1 {simple patterns} {
switch a a {format 1} b {format 2} c {format 3} default {format 4}
@@ -56,7 +59,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 +124,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 +180,19 @@ test switch-8.1 {empty body} {
default {set msg 2}
}
} {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/thread.test b/tests/thread.test
new file mode 100644
index 0000000..b3051ed
--- /dev/null
+++ b/tests/thread.test
@@ -0,0 +1,240 @@
+# 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: thread.test,v 1.2 1999/04/16 00:47:35 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[info command testthread] == ""} {
+ puts "skipping: tests require the testthread command"
+ ::tcltest::cleanupTests
+ return
+}
+
+set mainthread [testthread names]
+proc ThreadReap {} {
+ global mainthread
+ testthread errorproc ThreadNullError
+ while {[llength [testthread names]] > 1} {
+ foreach tid [testthread names] {
+ if {$tid != $mainthread} {
+ catch {testthread send -async $tid {testthread exit}}
+ update
+ }
+ }
+ }
+ testthread errorproc ThreadError
+ return [llength [testthread names]]
+}
+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} {
+ list [catch {testthread} msg] $msg
+} {1 {wrong # args: should be "testthread option ?args?"}}
+
+test thread-1.2 {Tcl_ThreadObjCmd: bad option} {
+ 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} {
+ list [catch {testthread names} mainthread] [llength $mainthread]
+} {0 1}
+
+test thread-1.4 {Tcl_ThreadObjCmd: thread create } {
+ set serverthread [testthread create]
+ update
+ set numthreads [llength [testthread names]]
+} {2}
+ThreadReap
+
+test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {
+ 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
+ }
+ }
+ set l
+} {1}
+ThreadReap
+
+test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {
+ testthread create {testthread exit}
+ update
+ after 10
+ llength [testthread names]
+} {1}
+ThreadReap
+
+test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {
+ 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} {
+ string compare [testthread id] $mainthread
+} {0}
+
+test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {
+ 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} {
+ string compare [testthread names] $mainthread
+} {0}
+
+test thread-1.11 {Tcl_ThreadObjCmd: send args} {
+ 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} {
+ 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} {
+ 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} {
+ set tid [expr $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} {
+ 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} {
+ 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 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} {
+ catch {unset tid}
+ foreach t {0 1 2} {
+ upvar #0 t$t tid
+ set tid [testthread create]
+ }
+ ThreadReap
+} 1
+
+test thread-3.1 {TclThreadList} {
+ catch {unset tid}
+ set mainthread [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 $mainthread $l1]] [lsort -integer $l2]]
+ ThreadReap
+ set c
+} 0
+
+test thread-4.1 {TclThreadSend to self} {
+ catch {unset x}
+ testthread send [testthread id] {
+ set x 4
+ }
+ set x
+} {4}
+
+test thread-4.1 {TclThreadSend -async} {
+ set mainthread [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
+ list [llength [testthread names]] $two
+} {1 2}
+
+test thread-4.2 {TclThreadSend preserve errorInfo} {
+ set mainthread [testthread names]
+ set serverthread [testthread create]
+ set x [catch {testthread send $serverthread {set undef}} msg]
+ list $x $msg $errorInfo
+} {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}"}}
+ThreadReap
+
+test thread-4.3 {TclThreadSend preserve code} {
+ set mainthread [testthread names]
+ set serverthread [testthread create]
+ set x [catch {testthread send $serverthread {break}} msg]
+ list $x $msg $errorInfo
+} {3 {} {}}
+ThreadReap
+
+test thread-4.4 {TclThreadSend preserve errorCode} {
+ set mainthread [testthread names]
+ set serverthread [testthread create]
+ set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
+ list $x $msg $errorCode
+} {1 ERR CODE}
+ThreadReap
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/timer.test b/tests/timer.test
index 7064d6d..0e6f4e6 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -8,13 +8,16 @@
# 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: timer.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: timer.test,v 1.3 1999/04/16 00:47:35 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
test timer-1.1 {Tcl_CreateTimerHandler procedure} {
foreach i [after info] {
@@ -333,12 +336,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 1 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 +537,18 @@ test timer-9.1 {AfterCleanupProc procedure} {
set x
} {before after2 after4}
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/trace.test b/tests/trace.test
index c0faa35..a2dd45e 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -6,13 +6,16 @@
#
# 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: trace.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: trace.test,v 1.3 1999/04/16 00:47:35 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
proc traceScalar {name1 name2 op} {
global info
@@ -610,10 +613,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 +966,19 @@ test trace-17.1 {unset traces on procedure returns} {
catch {unset x}
catch {unset y}
-concat {}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 76febd0..d026aa3 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,18 +9,22 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: unixFCmd.test,v 1.5 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.6 1999/04/16 00:47:35 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
-
-if {$tcl_platform(platform) != "unix"} {
- return
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
}
-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 +53,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 +61,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 +114,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 +135,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 +144,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 +152,122 @@ 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::testConfig(foundGroup) 0
+catch {
+ set groupList [exec groups]
+ set group [lindex $groupList 0]
+ set ::tcltest::testConfig(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]
+ 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} {
+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 +282,19 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable} {
set r
} {1 {error getting working directory name:}}
+# cleanup
cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixFile.test b/tests/unixFile.test
index c7f5b7c..c18ac20 100644
--- a/tests/unixFile.test
+++ b/tests/unixFile.test
@@ -4,63 +4,74 @@
# 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: unixFile.test,v 1.2 1998/09/14 18:40:14 stanton Exp $
+# RCS: @(#) $Id: unixFile.test,v 1.3 1999/04/16 00:47:35 stanton Exp $
-
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
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/tests/unixInit.test b/tests/unixInit.test
new file mode 100644
index 0000000..313f3c1
--- /dev/null
+++ b/tests/unixInit.test
@@ -0,0 +1,205 @@
+# 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: unixInit.test,v 1.2 1999/04/16 00:47:35 stanton Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+catch {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]" w+]
+ exec kill -PIPE [pid $f]
+ close $f
+}]} {
+ set ::tcltest::testConfig(installedTcl) 0
+} else {
+ set ::tcltest::testConfig(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]" w+]
+ puts $f "puts hi"
+ flush $f
+ gets $f
+ exec kill -PIPE [pid $f]
+ lappend x [catch {close $f}]
+
+ set f [open "|[list $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]}" {
+ 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::testConfig(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]]
+
+ set x {}
+ lappend x [string compare [lindex $path 0] $prefix/$installLib]
+ lappend x [string compare [lindex $path 1] [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 /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/tcl[info patchlevel]/library]
+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]" 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
+
+ set f [open "|[list $tcltest]" w+]
+ fconfigure $f -buffering none
+ puts $f {puts [encoding system]; exit}
+ set enc [gets $f]
+ close $f
+ unset env(LANG)
+
+ set enc
+} {euc-jp}
+
+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
+catch {unset env(TCL_LIBRARY); set env(TCL_LIBRARY) $oldlibrary}
+catch {unset env(LANG); set env(LANG) $oldlang}
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test