Compare commits
4
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 jan.nijtmans
|
f76c6ff3da | ||
|
jan.nijtmans
|
596fd6687e | ||
|
jan.nijtmans
|
35ca781f6c | ||
|
jan.nijtmans
|
28ac0c5353 |
@@ -1,19 +0,0 @@
|
||||
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
|
||||
compat/zlib/contrib/vstudio/readme.txt
|
||||
compat/zlib/contrib/vstudio/*/zlib.rc
|
||||
compat/zlib/win32/*.txt
|
||||
compat/zlib/win64/*.txt
|
||||
libtommath/*.dsp
|
||||
libtommath/*.sln
|
||||
libtommath/*.vcproj
|
||||
tools/tcl.hpj.in
|
||||
tools/tcl.wse.in
|
||||
win/buildall.vc.bat
|
||||
win/coffbase.txt
|
||||
win/makefile.vc
|
||||
win/rules.vc
|
||||
win/rules-ext.vc
|
||||
win/targets.vc
|
||||
win/tcl.dsp
|
||||
win/tcl.dsw
|
||||
win/tcl.hpj.in
|
||||
@@ -3,17 +3,13 @@ compat/zlib/contrib/vstudio/readme.txt
|
||||
compat/zlib/contrib/vstudio/*/zlib.rc
|
||||
compat/zlib/win32/*.txt
|
||||
compat/zlib/win64/*.txt
|
||||
libtommath/*.dsp
|
||||
libtommath/*.sln
|
||||
libtommath/*.vcproj
|
||||
tools/tcl.hpj.in
|
||||
tools/tcl.wse.in
|
||||
win/buildall.vc.bat
|
||||
win/coffbase.txt
|
||||
win/makefile.bc
|
||||
win/makefile.vc
|
||||
win/rules.vc
|
||||
win/rules-ext.vc
|
||||
win/targets.vc
|
||||
win/tcl.dsp
|
||||
win/tcl.dsw
|
||||
win/tcl.hpj.in
|
||||
@@ -2,6 +2,7 @@ tools/tcl.hpj.in
|
||||
tools/tcl.wse.in
|
||||
win/buildall.vc.bat
|
||||
win/coffbase.txt
|
||||
win/makefile.bc
|
||||
win/makefile.vc
|
||||
win/rules.vc
|
||||
win/tcl.dsp
|
||||
|
||||
@@ -18,7 +18,6 @@
|
||||
*/tclsh*
|
||||
*/tcltest*
|
||||
*/versions.vc
|
||||
*/version.vc
|
||||
html
|
||||
libtommath/bn.ilg
|
||||
libtommath/bn.ind
|
||||
@@ -41,9 +40,7 @@ unix/dltest.marker
|
||||
unix/tcl.pc
|
||||
unix/tclIndex
|
||||
unix/pkgs/*
|
||||
win/Debug*
|
||||
win/Release*
|
||||
win/Debug_VC*
|
||||
win/Release_VC*
|
||||
win/pkgs/*
|
||||
win/coffbase.txt
|
||||
win/tcl.hpj
|
||||
win/nmhlp-out.txt
|
||||
win/tcl.hpj
|
||||
@@ -1,6 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<projectDescription>
|
||||
<name>tcl8</name>
|
||||
<name>tcl8.7</name>
|
||||
<comment></comment>
|
||||
<projects>
|
||||
</projects>
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
README: Tcl
|
||||
This is the Tcl 8.7a2 source distribution.
|
||||
This is the Tcl 8.7a0 source distribution.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
You can get any source release of Tcl from the URL above.
|
||||
|
||||
|
||||
@@ -8624,263 +8624,3 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
|
||||
2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans)
|
||||
|
||||
--- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
2016-03-01 (bug)[803042] mem leak due to reference cycle (porter)
|
||||
|
||||
2016-03-08 (bug)[bbc304] reflected watch race condition (porter)
|
||||
|
||||
2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter)
|
||||
|
||||
2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter)
|
||||
|
||||
2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows)
|
||||
|
||||
2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans)
|
||||
|
||||
2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans)
|
||||
|
||||
2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans)
|
||||
|
||||
2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans)
|
||||
|
||||
2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin)
|
||||
|
||||
2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti)
|
||||
|
||||
2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny)
|
||||
|
||||
2016-05-13 (bug) registry package support any Unicode env (nijtmans)
|
||||
=> registry 1.3.2
|
||||
|
||||
2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)
|
||||
|
||||
2016-06-02 (TIP 447) execution time verbosity option (cerutti)
|
||||
=> tcltest 2.4.0
|
||||
|
||||
2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)
|
||||
|
||||
2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric)
|
||||
|
||||
2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter)
|
||||
|
||||
2016-06-21 (update) Update Unicode data to 9.0 (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter)
|
||||
|
||||
2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows)
|
||||
|
||||
2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect)
|
||||
|
||||
2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)
|
||||
|
||||
2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)
|
||||
|
||||
2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)
|
||||
|
||||
2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-10 (bug)[da340d] integer division in clock math (nadkarni)
|
||||
|
||||
2016-07-20 tzdata updated to Olson's tzdata2016f (venkat)
|
||||
|
||||
--- Released 8.6.6, July 27, 2016 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
2016-09-07 (bug)[c09edf] Bad caching with custom resolver (neumann,nijtmans)
|
||||
|
||||
2016-09-07 (bug)[4dbdd9] Memleak in test var-8.3 (mr_calvin,porter)
|
||||
|
||||
2016-10-03 (bug)[2bf561] Allow empty command as alias target (yorick,nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-10-04 (bug)[4d5ae7] Crash in async connects host no address (gahr,fellows)
|
||||
|
||||
2016-10-08 (bug)[838e99] treat application/xml as text (gahr,fellows)
|
||||
=> http 2.8.10
|
||||
|
||||
2016-10-11 (bug)[3cc1d9] Thread finalization crash in zippy (neumann)
|
||||
|
||||
2016-10-12 (bug)[be003d] Fix [scan 0x1 %b], [scan 0x1 %o] (porter)
|
||||
|
||||
2016-10-14 (bug)[eb6b68] Fix stringComp-14.5 (porter)
|
||||
|
||||
2016-10-30 (bug)[b26e38] Fix zlib-7.8 (fellows)
|
||||
|
||||
2016-10-30 (bug)[1ae129] Fix memleak in [history] destruction (fellows)
|
||||
|
||||
2016-11-04 (feature) Provisional Tcl 9 support in msgcat and tcltest (nijtmans)
|
||||
=> msgcat 1.6.1
|
||||
=> tcltest 2.4.1
|
||||
|
||||
2016-11-04 (bug)[824752] Crash in Tcl_ListObjReplace() (gahr,porter)
|
||||
|
||||
2016-11-11 (bug)[79614f] invalidate VFS mounts on sytem encoding change (yorick)
|
||||
|
||||
2016-11-14 OSX: End panic() as legacy support macro; system conflicts (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-11-15 (bug) TclOO fix stops crash mixing Itcl and snit (fellows)
|
||||
|
||||
2016-11-17 (update) Reconcile libtommath updates; purge unused files (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2017-01-09 (bug)[b87ad7] Repair drifts in timer clock (sebres)
|
||||
|
||||
2017-01-17 (update) => zlib 1.2.11 (nijtmans)
|
||||
|
||||
2017-01-31 (bug)[39f630] Revise Tcl_LinkVar to tolerate some prefixes (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2017-02-01 (bug)[d0f7ba] Improper NAN optimization. expr-22.1[01] (aspect)
|
||||
|
||||
2017-02-26 (bug)[25842c] zlib stream finalization (aspect)
|
||||
|
||||
2017-03-07 (deprecate) Remove unmaintained makefile.bc file (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2017-03-14 (enhancement) [clock] and [encoding] are now ensembles (kenny)
|
||||
|
||||
2017-03-15 (enhancement) several [clock] subcommands bytecoded (kenny)
|
||||
|
||||
2017-03-23 tzdata updated to Olson's tzdata2017b (jima)
|
||||
|
||||
2017-03-29 (bug)[900cb0] Fix OO unexport introspection (napier)
|
||||
|
||||
2017-04-12 (bug)[42202b] Nesting imbalance in coro injection (nadkarni,sebres)
|
||||
|
||||
2017-04-18 (bug)[bc4322] http package support for safe interps (nash,nijtmans)
|
||||
|
||||
2017-04-28 (bug)[f34cf8] [file join a //b] => /b (neumann,porter)
|
||||
|
||||
2017-05-01 (bug)[8bd13f] Windows threads and pipes (sebres,nijtmans)
|
||||
|
||||
2017-05-01 (bug)[f9fe90] [file join //a b] EIAS violation (aspect,porter)
|
||||
|
||||
2017-05-04 (bug) Make test filesystem-1.52 pass on Windows (nijtmans)
|
||||
|
||||
2017-05-05 (bug)[601522] [binary] field spec overflow -> segfault (porter)
|
||||
|
||||
2017-05-08 (bug)[6ca52a] http memleak handling keep-alive (aspect,nijtmans)
|
||||
=> http 2.8.11
|
||||
|
||||
2017-05-29 (bug)[a3fb33] crash in [lsort] on long lists (sebres)
|
||||
|
||||
2017-06-05 (bug)[67aa9a] Tcl_UtfToUniChar() revised handling invalid UTF-8 (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2017-06-08 (bug)[2738427] Tcl_NumUtfChars() corner case utf-4.9 (nijtmans)
|
||||
|
||||
2017-06-22 (update) Update Unicode data to 10.0 (nijtmans)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2017-06-22 (TIP 473) Let [oo::copy] specify target namespace (fellows)
|
||||
|
||||
2017-06-26 (bug)[46f801] Repair autoloader fragility (porter)
|
||||
|
||||
2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter)
|
||||
|
||||
2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans)
|
||||
|
||||
--- Released 8.6.7, August 9, 2017 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
2017-08-10 [array names -regexp] supports backrefs (goth)
|
||||
|
||||
2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows)
|
||||
|
||||
2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter)
|
||||
|
||||
2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
|
||||
=> http 2.8.12
|
||||
|
||||
2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
|
||||
|
||||
2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows)
|
||||
|
||||
2017-10-23 tzdata updated to Olson's tzdata2017c (jima)
|
||||
|
||||
2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows)
|
||||
|
||||
2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner)
|
||||
|
||||
2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter)
|
||||
|
||||
2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries)
|
||||
|
||||
2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann)
|
||||
|
||||
2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres)
|
||||
|
||||
2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter)
|
||||
|
||||
2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni)
|
||||
|
||||
2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter)
|
||||
|
||||
--- Released 8.6.8, December 22, 2017 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
|
||||
plus the following, which focuses on the high-level feature changes
|
||||
in this changeset (new minor version) rather than bug fixes:
|
||||
|
||||
2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter)
|
||||
*** POTENTIAL INCOMPATIBILITY ***
|
||||
|
||||
2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter)
|
||||
|
||||
2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans)
|
||||
|
||||
2016-07-19 (bug)[0363f0] Partial array search ID reform (porter)
|
||||
|
||||
2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter)
|
||||
*** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") ***
|
||||
|
||||
2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max)
|
||||
|
||||
2016-11-25 [array named -regexp] supports backrefs (goth)
|
||||
|
||||
2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy)
|
||||
|
||||
2017-01-04 (TIP 459) New subcommand [package files] (nijtmans)
|
||||
|
||||
2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans)
|
||||
|
||||
2017-01-30 Add to Win shell builtins: assoc ftype move (ashok)
|
||||
|
||||
2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans)
|
||||
|
||||
2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans)
|
||||
|
||||
2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz)
|
||||
|
||||
2017-05-31 Purge build support for SunOS-4.* (stu)
|
||||
|
||||
2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows)
|
||||
|
||||
2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows)
|
||||
=> TclOO 1.2.0
|
||||
|
||||
2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin)
|
||||
|
||||
2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
|
||||
|
||||
2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
|
||||
|
||||
--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details
|
||||
|
||||
2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann)
|
||||
|
||||
2018-03-12 (TIP 499) custom locale preference list (oehlmann)
|
||||
=> msgcat 1.7.0
|
||||
|
||||
@@ -0,0 +1,14 @@
|
||||
/*
|
||||
* float.h --
|
||||
*
|
||||
* This is a dummy header file to #include in Tcl when there
|
||||
* is no float.h in /usr/include. Right now this file is empty:
|
||||
* Tcl contains #ifdefs to deal with the lack of definitions;
|
||||
* all it needs is for the #include statement to work.
|
||||
*
|
||||
* Copyright (c) 1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
@@ -0,0 +1,209 @@
|
||||
1. Compression algorithm (deflate)
|
||||
|
||||
The deflation algorithm used by gzip (also zip and zlib) is a variation of
|
||||
LZ77 (Lempel-Ziv 1977, see reference below). It finds duplicated strings in
|
||||
the input data. The second occurrence of a string is replaced by a
|
||||
pointer to the previous string, in the form of a pair (distance,
|
||||
length). Distances are limited to 32K bytes, and lengths are limited
|
||||
to 258 bytes. When a string does not occur anywhere in the previous
|
||||
32K bytes, it is emitted as a sequence of literal bytes. (In this
|
||||
description, `string' must be taken as an arbitrary sequence of bytes,
|
||||
and is not restricted to printable characters.)
|
||||
|
||||
Literals or match lengths are compressed with one Huffman tree, and
|
||||
match distances are compressed with another tree. The trees are stored
|
||||
in a compact form at the start of each block. The blocks can have any
|
||||
size (except that the compressed data for one block must fit in
|
||||
available memory). A block is terminated when deflate() determines that
|
||||
it would be useful to start another block with fresh trees. (This is
|
||||
somewhat similar to the behavior of LZW-based _compress_.)
|
||||
|
||||
Duplicated strings are found using a hash table. All input strings of
|
||||
length 3 are inserted in the hash table. A hash index is computed for
|
||||
the next 3 bytes. If the hash chain for this index is not empty, all
|
||||
strings in the chain are compared with the current input string, and
|
||||
the longest match is selected.
|
||||
|
||||
The hash chains are searched starting with the most recent strings, to
|
||||
favor small distances and thus take advantage of the Huffman encoding.
|
||||
The hash chains are singly linked. There are no deletions from the
|
||||
hash chains, the algorithm simply discards matches that are too old.
|
||||
|
||||
To avoid a worst-case situation, very long hash chains are arbitrarily
|
||||
truncated at a certain length, determined by a runtime option (level
|
||||
parameter of deflateInit). So deflate() does not always find the longest
|
||||
possible match but generally finds a match which is long enough.
|
||||
|
||||
deflate() also defers the selection of matches with a lazy evaluation
|
||||
mechanism. After a match of length N has been found, deflate() searches for
|
||||
a longer match at the next input byte. If a longer match is found, the
|
||||
previous match is truncated to a length of one (thus producing a single
|
||||
literal byte) and the process of lazy evaluation begins again. Otherwise,
|
||||
the original match is kept, and the next match search is attempted only N
|
||||
steps later.
|
||||
|
||||
The lazy match evaluation is also subject to a runtime parameter. If
|
||||
the current match is long enough, deflate() reduces the search for a longer
|
||||
match, thus speeding up the whole process. If compression ratio is more
|
||||
important than speed, deflate() attempts a complete second search even if
|
||||
the first match is already long enough.
|
||||
|
||||
The lazy match evaluation is not performed for the fastest compression
|
||||
modes (level parameter 1 to 3). For these fast modes, new strings
|
||||
are inserted in the hash table only when no match was found, or
|
||||
when the match is not too long. This degrades the compression ratio
|
||||
but saves time since there are both fewer insertions and fewer searches.
|
||||
|
||||
|
||||
2. Decompression algorithm (inflate)
|
||||
|
||||
2.1 Introduction
|
||||
|
||||
The key question is how to represent a Huffman code (or any prefix code) so
|
||||
that you can decode fast. The most important characteristic is that shorter
|
||||
codes are much more common than longer codes, so pay attention to decoding the
|
||||
short codes fast, and let the long codes take longer to decode.
|
||||
|
||||
inflate() sets up a first level table that covers some number of bits of
|
||||
input less than the length of longest code. It gets that many bits from the
|
||||
stream, and looks it up in the table. The table will tell if the next
|
||||
code is that many bits or less and how many, and if it is, it will tell
|
||||
the value, else it will point to the next level table for which inflate()
|
||||
grabs more bits and tries to decode a longer code.
|
||||
|
||||
How many bits to make the first lookup is a tradeoff between the time it
|
||||
takes to decode and the time it takes to build the table. If building the
|
||||
table took no time (and if you had infinite memory), then there would only
|
||||
be a first level table to cover all the way to the longest code. However,
|
||||
building the table ends up taking a lot longer for more bits since short
|
||||
codes are replicated many times in such a table. What inflate() does is
|
||||
simply to make the number of bits in the first table a variable, and then
|
||||
to set that variable for the maximum speed.
|
||||
|
||||
For inflate, which has 286 possible codes for the literal/length tree, the size
|
||||
of the first table is nine bits. Also the distance trees have 30 possible
|
||||
values, and the size of the first table is six bits. Note that for each of
|
||||
those cases, the table ended up one bit longer than the ``average'' code
|
||||
length, i.e. the code length of an approximately flat code which would be a
|
||||
little more than eight bits for 286 symbols and a little less than five bits
|
||||
for 30 symbols.
|
||||
|
||||
|
||||
2.2 More details on the inflate table lookup
|
||||
|
||||
Ok, you want to know what this cleverly obfuscated inflate tree actually
|
||||
looks like. You are correct that it's not a Huffman tree. It is simply a
|
||||
lookup table for the first, let's say, nine bits of a Huffman symbol. The
|
||||
symbol could be as short as one bit or as long as 15 bits. If a particular
|
||||
symbol is shorter than nine bits, then that symbol's translation is duplicated
|
||||
in all those entries that start with that symbol's bits. For example, if the
|
||||
symbol is four bits, then it's duplicated 32 times in a nine-bit table. If a
|
||||
symbol is nine bits long, it appears in the table once.
|
||||
|
||||
If the symbol is longer than nine bits, then that entry in the table points
|
||||
to another similar table for the remaining bits. Again, there are duplicated
|
||||
entries as needed. The idea is that most of the time the symbol will be short
|
||||
and there will only be one table look up. (That's whole idea behind data
|
||||
compression in the first place.) For the less frequent long symbols, there
|
||||
will be two lookups. If you had a compression method with really long
|
||||
symbols, you could have as many levels of lookups as is efficient. For
|
||||
inflate, two is enough.
|
||||
|
||||
So a table entry either points to another table (in which case nine bits in
|
||||
the above example are gobbled), or it contains the translation for the symbol
|
||||
and the number of bits to gobble. Then you start again with the next
|
||||
ungobbled bit.
|
||||
|
||||
You may wonder: why not just have one lookup table for how ever many bits the
|
||||
longest symbol is? The reason is that if you do that, you end up spending
|
||||
more time filling in duplicate symbol entries than you do actually decoding.
|
||||
At least for deflate's output that generates new trees every several 10's of
|
||||
kbytes. You can imagine that filling in a 2^15 entry table for a 15-bit code
|
||||
would take too long if you're only decoding several thousand symbols. At the
|
||||
other extreme, you could make a new table for every bit in the code. In fact,
|
||||
that's essentially a Huffman tree. But then you spend too much time
|
||||
traversing the tree while decoding, even for short symbols.
|
||||
|
||||
So the number of bits for the first lookup table is a trade of the time to
|
||||
fill out the table vs. the time spent looking at the second level and above of
|
||||
the table.
|
||||
|
||||
Here is an example, scaled down:
|
||||
|
||||
The code being decoded, with 10 symbols, from 1 to 6 bits long:
|
||||
|
||||
A: 0
|
||||
B: 10
|
||||
C: 1100
|
||||
D: 11010
|
||||
E: 11011
|
||||
F: 11100
|
||||
G: 11101
|
||||
H: 11110
|
||||
I: 111110
|
||||
J: 111111
|
||||
|
||||
Let's make the first table three bits long (eight entries):
|
||||
|
||||
000: A,1
|
||||
001: A,1
|
||||
010: A,1
|
||||
011: A,1
|
||||
100: B,2
|
||||
101: B,2
|
||||
110: -> table X (gobble 3 bits)
|
||||
111: -> table Y (gobble 3 bits)
|
||||
|
||||
Each entry is what the bits decode as and how many bits that is, i.e. how
|
||||
many bits to gobble. Or the entry points to another table, with the number of
|
||||
bits to gobble implicit in the size of the table.
|
||||
|
||||
Table X is two bits long since the longest code starting with 110 is five bits
|
||||
long:
|
||||
|
||||
00: C,1
|
||||
01: C,1
|
||||
10: D,2
|
||||
11: E,2
|
||||
|
||||
Table Y is three bits long since the longest code starting with 111 is six
|
||||
bits long:
|
||||
|
||||
000: F,2
|
||||
001: F,2
|
||||
010: G,2
|
||||
011: G,2
|
||||
100: H,2
|
||||
101: H,2
|
||||
110: I,3
|
||||
111: J,3
|
||||
|
||||
So what we have here are three tables with a total of 20 entries that had to
|
||||
be constructed. That's compared to 64 entries for a single table. Or
|
||||
compared to 16 entries for a Huffman tree (six two entry tables and one four
|
||||
entry table). Assuming that the code ideally represents the probability of
|
||||
the symbols, it takes on the average 1.25 lookups per symbol. That's compared
|
||||
to one lookup for the single table, or 1.66 lookups per symbol for the
|
||||
Huffman tree.
|
||||
|
||||
There, I think that gives you a picture of what's going on. For inflate, the
|
||||
meaning of a particular symbol is often more than just a letter. It can be a
|
||||
byte (a "literal"), or it can be either a length or a distance which
|
||||
indicates a base value and a number of bits to fetch after the code that is
|
||||
added to the base value. Or it might be the special end-of-block code. The
|
||||
data structures created in inftrees.c try to encode all that information
|
||||
compactly in the tables.
|
||||
|
||||
|
||||
Jean-loup Gailly Mark Adler
|
||||
jloup@gzip.org madler@alumni.caltech.edu
|
||||
|
||||
|
||||
References:
|
||||
|
||||
[LZ77] Ziv J., Lempel A., ``A Universal Algorithm for Sequential Data
|
||||
Compression,'' IEEE Transactions on Information Theory, Vol. 23, No. 3,
|
||||
pp. 337-343.
|
||||
|
||||
``DEFLATE Compressed Data Format Specification'' available in
|
||||
http://tools.ietf.org/html/rfc1951
|
||||
@@ -0,0 +1,619 @@
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Network Working Group P. Deutsch
|
||||
Request for Comments: 1950 Aladdin Enterprises
|
||||
Category: Informational J-L. Gailly
|
||||
Info-ZIP
|
||||
May 1996
|
||||
|
||||
|
||||
ZLIB Compressed Data Format Specification version 3.3
|
||||
|
||||
Status of This Memo
|
||||
|
||||
This memo provides information for the Internet community. This memo
|
||||
does not specify an Internet standard of any kind. Distribution of
|
||||
this memo is unlimited.
|
||||
|
||||
IESG Note:
|
||||
|
||||
The IESG takes no position on the validity of any Intellectual
|
||||
Property Rights statements contained in this document.
|
||||
|
||||
Notices
|
||||
|
||||
Copyright (c) 1996 L. Peter Deutsch and Jean-Loup Gailly
|
||||
|
||||
Permission is granted to copy and distribute this document for any
|
||||
purpose and without charge, including translations into other
|
||||
languages and incorporation into compilations, provided that the
|
||||
copyright notice and this notice are preserved, and that any
|
||||
substantive changes or deletions from the original are clearly
|
||||
marked.
|
||||
|
||||
A pointer to the latest version of this and related documentation in
|
||||
HTML format can be found at the URL
|
||||
<ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html>.
|
||||
|
||||
Abstract
|
||||
|
||||
This specification defines a lossless compressed data format. The
|
||||
data can be produced or consumed, even for an arbitrarily long
|
||||
sequentially presented input data stream, using only an a priori
|
||||
bounded amount of intermediate storage. The format presently uses
|
||||
the DEFLATE compression method but can be easily extended to use
|
||||
other compression methods. It can be implemented readily in a manner
|
||||
not covered by patents. This specification also defines the ADLER-32
|
||||
checksum (an extension and improvement of the Fletcher checksum),
|
||||
used for detection of data corruption, and provides an algorithm for
|
||||
computing it.
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 1]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
Table of Contents
|
||||
|
||||
1. Introduction ................................................... 2
|
||||
1.1. Purpose ................................................... 2
|
||||
1.2. Intended audience ......................................... 3
|
||||
1.3. Scope ..................................................... 3
|
||||
1.4. Compliance ................................................ 3
|
||||
1.5. Definitions of terms and conventions used ................ 3
|
||||
1.6. Changes from previous versions ............................ 3
|
||||
2. Detailed specification ......................................... 3
|
||||
2.1. Overall conventions ....................................... 3
|
||||
2.2. Data format ............................................... 4
|
||||
2.3. Compliance ................................................ 7
|
||||
3. References ..................................................... 7
|
||||
4. Source code .................................................... 8
|
||||
5. Security Considerations ........................................ 8
|
||||
6. Acknowledgements ............................................... 8
|
||||
7. Authors' Addresses ............................................. 8
|
||||
8. Appendix: Rationale ............................................ 9
|
||||
9. Appendix: Sample code ..........................................10
|
||||
|
||||
1. Introduction
|
||||
|
||||
1.1. Purpose
|
||||
|
||||
The purpose of this specification is to define a lossless
|
||||
compressed data format that:
|
||||
|
||||
* Is independent of CPU type, operating system, file system,
|
||||
and character set, and hence can be used for interchange;
|
||||
|
||||
* Can be produced or consumed, even for an arbitrarily long
|
||||
sequentially presented input data stream, using only an a
|
||||
priori bounded amount of intermediate storage, and hence can
|
||||
be used in data communications or similar structures such as
|
||||
Unix filters;
|
||||
|
||||
* Can use a number of different compression methods;
|
||||
|
||||
* Can be implemented readily in a manner not covered by
|
||||
patents, and hence can be practiced freely.
|
||||
|
||||
The data format defined by this specification does not attempt to
|
||||
allow random access to compressed data.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 2]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
1.2. Intended audience
|
||||
|
||||
This specification is intended for use by implementors of software
|
||||
to compress data into zlib format and/or decompress data from zlib
|
||||
format.
|
||||
|
||||
The text of the specification assumes a basic background in
|
||||
programming at the level of bits and other primitive data
|
||||
representations.
|
||||
|
||||
1.3. Scope
|
||||
|
||||
The specification specifies a compressed data format that can be
|
||||
used for in-memory compression of a sequence of arbitrary bytes.
|
||||
|
||||
1.4. Compliance
|
||||
|
||||
Unless otherwise indicated below, a compliant decompressor must be
|
||||
able to accept and decompress any data set that conforms to all
|
||||
the specifications presented here; a compliant compressor must
|
||||
produce data sets that conform to all the specifications presented
|
||||
here.
|
||||
|
||||
1.5. Definitions of terms and conventions used
|
||||
|
||||
byte: 8 bits stored or transmitted as a unit (same as an octet).
|
||||
(For this specification, a byte is exactly 8 bits, even on
|
||||
machines which store a character on a number of bits different
|
||||
from 8.) See below, for the numbering of bits within a byte.
|
||||
|
||||
1.6. Changes from previous versions
|
||||
|
||||
Version 3.1 was the first public release of this specification.
|
||||
In version 3.2, some terminology was changed and the Adler-32
|
||||
sample code was rewritten for clarity. In version 3.3, the
|
||||
support for a preset dictionary was introduced, and the
|
||||
specification was converted to RFC style.
|
||||
|
||||
2. Detailed specification
|
||||
|
||||
2.1. Overall conventions
|
||||
|
||||
In the diagrams below, a box like this:
|
||||
|
||||
+---+
|
||||
| | <-- the vertical bars might be missing
|
||||
+---+
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 3]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
represents one byte; a box like this:
|
||||
|
||||
+==============+
|
||||
| |
|
||||
+==============+
|
||||
|
||||
represents a variable number of bytes.
|
||||
|
||||
Bytes stored within a computer do not have a "bit order", since
|
||||
they are always treated as a unit. However, a byte considered as
|
||||
an integer between 0 and 255 does have a most- and least-
|
||||
significant bit, and since we write numbers with the most-
|
||||
significant digit on the left, we also write bytes with the most-
|
||||
significant bit on the left. In the diagrams below, we number the
|
||||
bits of a byte so that bit 0 is the least-significant bit, i.e.,
|
||||
the bits are numbered:
|
||||
|
||||
+--------+
|
||||
|76543210|
|
||||
+--------+
|
||||
|
||||
Within a computer, a number may occupy multiple bytes. All
|
||||
multi-byte numbers in the format described here are stored with
|
||||
the MOST-significant byte first (at the lower memory address).
|
||||
For example, the decimal number 520 is stored as:
|
||||
|
||||
0 1
|
||||
+--------+--------+
|
||||
|00000010|00001000|
|
||||
+--------+--------+
|
||||
^ ^
|
||||
| |
|
||||
| + less significant byte = 8
|
||||
+ more significant byte = 2 x 256
|
||||
|
||||
2.2. Data format
|
||||
|
||||
A zlib stream has the following structure:
|
||||
|
||||
0 1
|
||||
+---+---+
|
||||
|CMF|FLG| (more-->)
|
||||
+---+---+
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 4]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
(if FLG.FDICT set)
|
||||
|
||||
0 1 2 3
|
||||
+---+---+---+---+
|
||||
| DICTID | (more-->)
|
||||
+---+---+---+---+
|
||||
|
||||
+=====================+---+---+---+---+
|
||||
|...compressed data...| ADLER32 |
|
||||
+=====================+---+---+---+---+
|
||||
|
||||
Any data which may appear after ADLER32 are not part of the zlib
|
||||
stream.
|
||||
|
||||
CMF (Compression Method and flags)
|
||||
This byte is divided into a 4-bit compression method and a 4-
|
||||
bit information field depending on the compression method.
|
||||
|
||||
bits 0 to 3 CM Compression method
|
||||
bits 4 to 7 CINFO Compression info
|
||||
|
||||
CM (Compression method)
|
||||
This identifies the compression method used in the file. CM = 8
|
||||
denotes the "deflate" compression method with a window size up
|
||||
to 32K. This is the method used by gzip and PNG (see
|
||||
references [1] and [2] in Chapter 3, below, for the reference
|
||||
documents). CM = 15 is reserved. It might be used in a future
|
||||
version of this specification to indicate the presence of an
|
||||
extra field before the compressed data.
|
||||
|
||||
CINFO (Compression info)
|
||||
For CM = 8, CINFO is the base-2 logarithm of the LZ77 window
|
||||
size, minus eight (CINFO=7 indicates a 32K window size). Values
|
||||
of CINFO above 7 are not allowed in this version of the
|
||||
specification. CINFO is not defined in this specification for
|
||||
CM not equal to 8.
|
||||
|
||||
FLG (FLaGs)
|
||||
This flag byte is divided as follows:
|
||||
|
||||
bits 0 to 4 FCHECK (check bits for CMF and FLG)
|
||||
bit 5 FDICT (preset dictionary)
|
||||
bits 6 to 7 FLEVEL (compression level)
|
||||
|
||||
The FCHECK value must be such that CMF and FLG, when viewed as
|
||||
a 16-bit unsigned integer stored in MSB order (CMF*256 + FLG),
|
||||
is a multiple of 31.
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 5]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
FDICT (Preset dictionary)
|
||||
If FDICT is set, a DICT dictionary identifier is present
|
||||
immediately after the FLG byte. The dictionary is a sequence of
|
||||
bytes which are initially fed to the compressor without
|
||||
producing any compressed output. DICT is the Adler-32 checksum
|
||||
of this sequence of bytes (see the definition of ADLER32
|
||||
below). The decompressor can use this identifier to determine
|
||||
which dictionary has been used by the compressor.
|
||||
|
||||
FLEVEL (Compression level)
|
||||
These flags are available for use by specific compression
|
||||
methods. The "deflate" method (CM = 8) sets these flags as
|
||||
follows:
|
||||
|
||||
0 - compressor used fastest algorithm
|
||||
1 - compressor used fast algorithm
|
||||
2 - compressor used default algorithm
|
||||
3 - compressor used maximum compression, slowest algorithm
|
||||
|
||||
The information in FLEVEL is not needed for decompression; it
|
||||
is there to indicate if recompression might be worthwhile.
|
||||
|
||||
compressed data
|
||||
For compression method 8, the compressed data is stored in the
|
||||
deflate compressed data format as described in the document
|
||||
"DEFLATE Compressed Data Format Specification" by L. Peter
|
||||
Deutsch. (See reference [3] in Chapter 3, below)
|
||||
|
||||
Other compressed data formats are not specified in this version
|
||||
of the zlib specification.
|
||||
|
||||
ADLER32 (Adler-32 checksum)
|
||||
This contains a checksum value of the uncompressed data
|
||||
(excluding any dictionary data) computed according to Adler-32
|
||||
algorithm. This algorithm is a 32-bit extension and improvement
|
||||
of the Fletcher algorithm, used in the ITU-T X.224 / ISO 8073
|
||||
standard. See references [4] and [5] in Chapter 3, below)
|
||||
|
||||
Adler-32 is composed of two sums accumulated per byte: s1 is
|
||||
the sum of all bytes, s2 is the sum of all s1 values. Both sums
|
||||
are done modulo 65521. s1 is initialized to 1, s2 to zero. The
|
||||
Adler-32 checksum is stored as s2*65536 + s1 in most-
|
||||
significant-byte first (network) order.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 6]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
2.3. Compliance
|
||||
|
||||
A compliant compressor must produce streams with correct CMF, FLG
|
||||
and ADLER32, but need not support preset dictionaries. When the
|
||||
zlib data format is used as part of another standard data format,
|
||||
the compressor may use only preset dictionaries that are specified
|
||||
by this other data format. If this other format does not use the
|
||||
preset dictionary feature, the compressor must not set the FDICT
|
||||
flag.
|
||||
|
||||
A compliant decompressor must check CMF, FLG, and ADLER32, and
|
||||
provide an error indication if any of these have incorrect values.
|
||||
A compliant decompressor must give an error indication if CM is
|
||||
not one of the values defined in this specification (only the
|
||||
value 8 is permitted in this version), since another value could
|
||||
indicate the presence of new features that would cause subsequent
|
||||
data to be interpreted incorrectly. A compliant decompressor must
|
||||
give an error indication if FDICT is set and DICTID is not the
|
||||
identifier of a known preset dictionary. A decompressor may
|
||||
ignore FLEVEL and still be compliant. When the zlib data format
|
||||
is being used as a part of another standard format, a compliant
|
||||
decompressor must support all the preset dictionaries specified by
|
||||
the other format. When the other format does not use the preset
|
||||
dictionary feature, a compliant decompressor must reject any
|
||||
stream in which the FDICT flag is set.
|
||||
|
||||
3. References
|
||||
|
||||
[1] Deutsch, L.P.,"GZIP Compressed Data Format Specification",
|
||||
available in ftp://ftp.uu.net/pub/archiving/zip/doc/
|
||||
|
||||
[2] Thomas Boutell, "PNG (Portable Network Graphics) specification",
|
||||
available in ftp://ftp.uu.net/graphics/png/documents/
|
||||
|
||||
[3] Deutsch, L.P.,"DEFLATE Compressed Data Format Specification",
|
||||
available in ftp://ftp.uu.net/pub/archiving/zip/doc/
|
||||
|
||||
[4] Fletcher, J. G., "An Arithmetic Checksum for Serial
|
||||
Transmissions," IEEE Transactions on Communications, Vol. COM-30,
|
||||
No. 1, January 1982, pp. 247-252.
|
||||
|
||||
[5] ITU-T Recommendation X.224, Annex D, "Checksum Algorithms,"
|
||||
November, 1993, pp. 144, 145. (Available from
|
||||
gopher://info.itu.ch). ITU-T X.244 is also the same as ISO 8073.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 7]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
4. Source code
|
||||
|
||||
Source code for a C language implementation of a "zlib" compliant
|
||||
library is available at ftp://ftp.uu.net/pub/archiving/zip/zlib/.
|
||||
|
||||
5. Security Considerations
|
||||
|
||||
A decoder that fails to check the ADLER32 checksum value may be
|
||||
subject to undetected data corruption.
|
||||
|
||||
6. Acknowledgements
|
||||
|
||||
Trademarks cited in this document are the property of their
|
||||
respective owners.
|
||||
|
||||
Jean-Loup Gailly and Mark Adler designed the zlib format and wrote
|
||||
the related software described in this specification. Glenn
|
||||
Randers-Pehrson converted this document to RFC and HTML format.
|
||||
|
||||
7. Authors' Addresses
|
||||
|
||||
L. Peter Deutsch
|
||||
Aladdin Enterprises
|
||||
203 Santa Margarita Ave.
|
||||
Menlo Park, CA 94025
|
||||
|
||||
Phone: (415) 322-0103 (AM only)
|
||||
FAX: (415) 322-1734
|
||||
EMail: <ghost@aladdin.com>
|
||||
|
||||
|
||||
Jean-Loup Gailly
|
||||
|
||||
EMail: <gzip@prep.ai.mit.edu>
|
||||
|
||||
Questions about the technical content of this specification can be
|
||||
sent by email to
|
||||
|
||||
Jean-Loup Gailly <gzip@prep.ai.mit.edu> and
|
||||
Mark Adler <madler@alumni.caltech.edu>
|
||||
|
||||
Editorial comments on this specification can be sent by email to
|
||||
|
||||
L. Peter Deutsch <ghost@aladdin.com> and
|
||||
Glenn Randers-Pehrson <randeg@alumni.rpi.edu>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 8]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
8. Appendix: Rationale
|
||||
|
||||
8.1. Preset dictionaries
|
||||
|
||||
A preset dictionary is specially useful to compress short input
|
||||
sequences. The compressor can take advantage of the dictionary
|
||||
context to encode the input in a more compact manner. The
|
||||
decompressor can be initialized with the appropriate context by
|
||||
virtually decompressing a compressed version of the dictionary
|
||||
without producing any output. However for certain compression
|
||||
algorithms such as the deflate algorithm this operation can be
|
||||
achieved without actually performing any decompression.
|
||||
|
||||
The compressor and the decompressor must use exactly the same
|
||||
dictionary. The dictionary may be fixed or may be chosen among a
|
||||
certain number of predefined dictionaries, according to the kind
|
||||
of input data. The decompressor can determine which dictionary has
|
||||
been chosen by the compressor by checking the dictionary
|
||||
identifier. This document does not specify the contents of
|
||||
predefined dictionaries, since the optimal dictionaries are
|
||||
application specific. Standard data formats using this feature of
|
||||
the zlib specification must precisely define the allowed
|
||||
dictionaries.
|
||||
|
||||
8.2. The Adler-32 algorithm
|
||||
|
||||
The Adler-32 algorithm is much faster than the CRC32 algorithm yet
|
||||
still provides an extremely low probability of undetected errors.
|
||||
|
||||
The modulo on unsigned long accumulators can be delayed for 5552
|
||||
bytes, so the modulo operation time is negligible. If the bytes
|
||||
are a, b, c, the second sum is 3a + 2b + c + 3, and so is position
|
||||
and order sensitive, unlike the first sum, which is just a
|
||||
checksum. That 65521 is prime is important to avoid a possible
|
||||
large class of two-byte errors that leave the check unchanged.
|
||||
(The Fletcher checksum uses 255, which is not prime and which also
|
||||
makes the Fletcher check insensitive to single byte changes 0 <->
|
||||
255.)
|
||||
|
||||
The sum s1 is initialized to 1 instead of zero to make the length
|
||||
of the sequence part of s2, so that the length does not have to be
|
||||
checked separately. (Any sequence of zeroes has a Fletcher
|
||||
checksum of zero.)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 9]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
9. Appendix: Sample code
|
||||
|
||||
The following C code computes the Adler-32 checksum of a data buffer.
|
||||
It is written for clarity, not for speed. The sample code is in the
|
||||
ANSI C programming language. Non C users may find it easier to read
|
||||
with these hints:
|
||||
|
||||
& Bitwise AND operator.
|
||||
>> Bitwise right shift operator. When applied to an
|
||||
unsigned quantity, as here, right shift inserts zero bit(s)
|
||||
at the left.
|
||||
<< Bitwise left shift operator. Left shift inserts zero
|
||||
bit(s) at the right.
|
||||
++ "n++" increments the variable n.
|
||||
% modulo operator: a % b is the remainder of a divided by b.
|
||||
|
||||
#define BASE 65521 /* largest prime smaller than 65536 */
|
||||
|
||||
/*
|
||||
Update a running Adler-32 checksum with the bytes buf[0..len-1]
|
||||
and return the updated checksum. The Adler-32 checksum should be
|
||||
initialized to 1.
|
||||
|
||||
Usage example:
|
||||
|
||||
unsigned long adler = 1L;
|
||||
|
||||
while (read_buffer(buffer, length) != EOF) {
|
||||
adler = update_adler32(adler, buffer, length);
|
||||
}
|
||||
if (adler != original_adler) error();
|
||||
*/
|
||||
unsigned long update_adler32(unsigned long adler,
|
||||
unsigned char *buf, int len)
|
||||
{
|
||||
unsigned long s1 = adler & 0xffff;
|
||||
unsigned long s2 = (adler >> 16) & 0xffff;
|
||||
int n;
|
||||
|
||||
for (n = 0; n < len; n++) {
|
||||
s1 = (s1 + buf[n]) % BASE;
|
||||
s2 = (s2 + s1) % BASE;
|
||||
}
|
||||
return (s2 << 16) + s1;
|
||||
}
|
||||
|
||||
/* Return the adler32 of the bytes buf[0..len-1] */
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 10]
|
||||
|
||||
RFC 1950 ZLIB Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
unsigned long adler32(unsigned char *buf, int len)
|
||||
{
|
||||
return update_adler32(1L, buf, len);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch & Gailly Informational [Page 11]
|
||||
|
||||
@@ -0,0 +1,955 @@
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Network Working Group P. Deutsch
|
||||
Request for Comments: 1951 Aladdin Enterprises
|
||||
Category: Informational May 1996
|
||||
|
||||
|
||||
DEFLATE Compressed Data Format Specification version 1.3
|
||||
|
||||
Status of This Memo
|
||||
|
||||
This memo provides information for the Internet community. This memo
|
||||
does not specify an Internet standard of any kind. Distribution of
|
||||
this memo is unlimited.
|
||||
|
||||
IESG Note:
|
||||
|
||||
The IESG takes no position on the validity of any Intellectual
|
||||
Property Rights statements contained in this document.
|
||||
|
||||
Notices
|
||||
|
||||
Copyright (c) 1996 L. Peter Deutsch
|
||||
|
||||
Permission is granted to copy and distribute this document for any
|
||||
purpose and without charge, including translations into other
|
||||
languages and incorporation into compilations, provided that the
|
||||
copyright notice and this notice are preserved, and that any
|
||||
substantive changes or deletions from the original are clearly
|
||||
marked.
|
||||
|
||||
A pointer to the latest version of this and related documentation in
|
||||
HTML format can be found at the URL
|
||||
<ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html>.
|
||||
|
||||
Abstract
|
||||
|
||||
This specification defines a lossless compressed data format that
|
||||
compresses data using a combination of the LZ77 algorithm and Huffman
|
||||
coding, with efficiency comparable to the best currently available
|
||||
general-purpose compression methods. The data can be produced or
|
||||
consumed, even for an arbitrarily long sequentially presented input
|
||||
data stream, using only an a priori bounded amount of intermediate
|
||||
storage. The format can be implemented readily in a manner not
|
||||
covered by patents.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 1]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
Table of Contents
|
||||
|
||||
1. Introduction ................................................... 2
|
||||
1.1. Purpose ................................................... 2
|
||||
1.2. Intended audience ......................................... 3
|
||||
1.3. Scope ..................................................... 3
|
||||
1.4. Compliance ................................................ 3
|
||||
1.5. Definitions of terms and conventions used ................ 3
|
||||
1.6. Changes from previous versions ............................ 4
|
||||
2. Compressed representation overview ............................. 4
|
||||
3. Detailed specification ......................................... 5
|
||||
3.1. Overall conventions ....................................... 5
|
||||
3.1.1. Packing into bytes .................................. 5
|
||||
3.2. Compressed block format ................................... 6
|
||||
3.2.1. Synopsis of prefix and Huffman coding ............... 6
|
||||
3.2.2. Use of Huffman coding in the "deflate" format ....... 7
|
||||
3.2.3. Details of block format ............................. 9
|
||||
3.2.4. Non-compressed blocks (BTYPE=00) ................... 11
|
||||
3.2.5. Compressed blocks (length and distance codes) ...... 11
|
||||
3.2.6. Compression with fixed Huffman codes (BTYPE=01) .... 12
|
||||
3.2.7. Compression with dynamic Huffman codes (BTYPE=10) .. 13
|
||||
3.3. Compliance ............................................... 14
|
||||
4. Compression algorithm details ................................. 14
|
||||
5. References .................................................... 16
|
||||
6. Security Considerations ....................................... 16
|
||||
7. Source code ................................................... 16
|
||||
8. Acknowledgements .............................................. 16
|
||||
9. Author's Address .............................................. 17
|
||||
|
||||
1. Introduction
|
||||
|
||||
1.1. Purpose
|
||||
|
||||
The purpose of this specification is to define a lossless
|
||||
compressed data format that:
|
||||
* Is independent of CPU type, operating system, file system,
|
||||
and character set, and hence can be used for interchange;
|
||||
* Can be produced or consumed, even for an arbitrarily long
|
||||
sequentially presented input data stream, using only an a
|
||||
priori bounded amount of intermediate storage, and hence
|
||||
can be used in data communications or similar structures
|
||||
such as Unix filters;
|
||||
* Compresses data with efficiency comparable to the best
|
||||
currently available general-purpose compression methods,
|
||||
and in particular considerably better than the "compress"
|
||||
program;
|
||||
* Can be implemented readily in a manner not covered by
|
||||
patents, and hence can be practiced freely;
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 2]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
* Is compatible with the file format produced by the current
|
||||
widely used gzip utility, in that conforming decompressors
|
||||
will be able to read data produced by the existing gzip
|
||||
compressor.
|
||||
|
||||
The data format defined by this specification does not attempt to:
|
||||
|
||||
* Allow random access to compressed data;
|
||||
* Compress specialized data (e.g., raster graphics) as well
|
||||
as the best currently available specialized algorithms.
|
||||
|
||||
A simple counting argument shows that no lossless compression
|
||||
algorithm can compress every possible input data set. For the
|
||||
format defined here, the worst case expansion is 5 bytes per 32K-
|
||||
byte block, i.e., a size increase of 0.015% for large data sets.
|
||||
English text usually compresses by a factor of 2.5 to 3;
|
||||
executable files usually compress somewhat less; graphical data
|
||||
such as raster images may compress much more.
|
||||
|
||||
1.2. Intended audience
|
||||
|
||||
This specification is intended for use by implementors of software
|
||||
to compress data into "deflate" format and/or decompress data from
|
||||
"deflate" format.
|
||||
|
||||
The text of the specification assumes a basic background in
|
||||
programming at the level of bits and other primitive data
|
||||
representations. Familiarity with the technique of Huffman coding
|
||||
is helpful but not required.
|
||||
|
||||
1.3. Scope
|
||||
|
||||
The specification specifies a method for representing a sequence
|
||||
of bytes as a (usually shorter) sequence of bits, and a method for
|
||||
packing the latter bit sequence into bytes.
|
||||
|
||||
1.4. Compliance
|
||||
|
||||
Unless otherwise indicated below, a compliant decompressor must be
|
||||
able to accept and decompress any data set that conforms to all
|
||||
the specifications presented here; a compliant compressor must
|
||||
produce data sets that conform to all the specifications presented
|
||||
here.
|
||||
|
||||
1.5. Definitions of terms and conventions used
|
||||
|
||||
Byte: 8 bits stored or transmitted as a unit (same as an octet).
|
||||
For this specification, a byte is exactly 8 bits, even on machines
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 3]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
which store a character on a number of bits different from eight.
|
||||
See below, for the numbering of bits within a byte.
|
||||
|
||||
String: a sequence of arbitrary bytes.
|
||||
|
||||
1.6. Changes from previous versions
|
||||
|
||||
There have been no technical changes to the deflate format since
|
||||
version 1.1 of this specification. In version 1.2, some
|
||||
terminology was changed. Version 1.3 is a conversion of the
|
||||
specification to RFC style.
|
||||
|
||||
2. Compressed representation overview
|
||||
|
||||
A compressed data set consists of a series of blocks, corresponding
|
||||
to successive blocks of input data. The block sizes are arbitrary,
|
||||
except that non-compressible blocks are limited to 65,535 bytes.
|
||||
|
||||
Each block is compressed using a combination of the LZ77 algorithm
|
||||
and Huffman coding. The Huffman trees for each block are independent
|
||||
of those for previous or subsequent blocks; the LZ77 algorithm may
|
||||
use a reference to a duplicated string occurring in a previous block,
|
||||
up to 32K input bytes before.
|
||||
|
||||
Each block consists of two parts: a pair of Huffman code trees that
|
||||
describe the representation of the compressed data part, and a
|
||||
compressed data part. (The Huffman trees themselves are compressed
|
||||
using Huffman encoding.) The compressed data consists of a series of
|
||||
elements of two types: literal bytes (of strings that have not been
|
||||
detected as duplicated within the previous 32K input bytes), and
|
||||
pointers to duplicated strings, where a pointer is represented as a
|
||||
pair <length, backward distance>. The representation used in the
|
||||
"deflate" format limits distances to 32K bytes and lengths to 258
|
||||
bytes, but does not limit the size of a block, except for
|
||||
uncompressible blocks, which are limited as noted above.
|
||||
|
||||
Each type of value (literals, distances, and lengths) in the
|
||||
compressed data is represented using a Huffman code, using one code
|
||||
tree for literals and lengths and a separate code tree for distances.
|
||||
The code trees for each block appear in a compact form just before
|
||||
the compressed data for that block.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 4]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
3. Detailed specification
|
||||
|
||||
3.1. Overall conventions In the diagrams below, a box like this:
|
||||
|
||||
+---+
|
||||
| | <-- the vertical bars might be missing
|
||||
+---+
|
||||
|
||||
represents one byte; a box like this:
|
||||
|
||||
+==============+
|
||||
| |
|
||||
+==============+
|
||||
|
||||
represents a variable number of bytes.
|
||||
|
||||
Bytes stored within a computer do not have a "bit order", since
|
||||
they are always treated as a unit. However, a byte considered as
|
||||
an integer between 0 and 255 does have a most- and least-
|
||||
significant bit, and since we write numbers with the most-
|
||||
significant digit on the left, we also write bytes with the most-
|
||||
significant bit on the left. In the diagrams below, we number the
|
||||
bits of a byte so that bit 0 is the least-significant bit, i.e.,
|
||||
the bits are numbered:
|
||||
|
||||
+--------+
|
||||
|76543210|
|
||||
+--------+
|
||||
|
||||
Within a computer, a number may occupy multiple bytes. All
|
||||
multi-byte numbers in the format described here are stored with
|
||||
the least-significant byte first (at the lower memory address).
|
||||
For example, the decimal number 520 is stored as:
|
||||
|
||||
0 1
|
||||
+--------+--------+
|
||||
|00001000|00000010|
|
||||
+--------+--------+
|
||||
^ ^
|
||||
| |
|
||||
| + more significant byte = 2 x 256
|
||||
+ less significant byte = 8
|
||||
|
||||
3.1.1. Packing into bytes
|
||||
|
||||
This document does not address the issue of the order in which
|
||||
bits of a byte are transmitted on a bit-sequential medium,
|
||||
since the final data format described here is byte- rather than
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 5]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
bit-oriented. However, we describe the compressed block format
|
||||
in below, as a sequence of data elements of various bit
|
||||
lengths, not a sequence of bytes. We must therefore specify
|
||||
how to pack these data elements into bytes to form the final
|
||||
compressed byte sequence:
|
||||
|
||||
* Data elements are packed into bytes in order of
|
||||
increasing bit number within the byte, i.e., starting
|
||||
with the least-significant bit of the byte.
|
||||
* Data elements other than Huffman codes are packed
|
||||
starting with the least-significant bit of the data
|
||||
element.
|
||||
* Huffman codes are packed starting with the most-
|
||||
significant bit of the code.
|
||||
|
||||
In other words, if one were to print out the compressed data as
|
||||
a sequence of bytes, starting with the first byte at the
|
||||
*right* margin and proceeding to the *left*, with the most-
|
||||
significant bit of each byte on the left as usual, one would be
|
||||
able to parse the result from right to left, with fixed-width
|
||||
elements in the correct MSB-to-LSB order and Huffman codes in
|
||||
bit-reversed order (i.e., with the first bit of the code in the
|
||||
relative LSB position).
|
||||
|
||||
3.2. Compressed block format
|
||||
|
||||
3.2.1. Synopsis of prefix and Huffman coding
|
||||
|
||||
Prefix coding represents symbols from an a priori known
|
||||
alphabet by bit sequences (codes), one code for each symbol, in
|
||||
a manner such that different symbols may be represented by bit
|
||||
sequences of different lengths, but a parser can always parse
|
||||
an encoded string unambiguously symbol-by-symbol.
|
||||
|
||||
We define a prefix code in terms of a binary tree in which the
|
||||
two edges descending from each non-leaf node are labeled 0 and
|
||||
1 and in which the leaf nodes correspond one-for-one with (are
|
||||
labeled with) the symbols of the alphabet; then the code for a
|
||||
symbol is the sequence of 0's and 1's on the edges leading from
|
||||
the root to the leaf labeled with that symbol. For example:
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 6]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
/\ Symbol Code
|
||||
0 1 ------ ----
|
||||
/ \ A 00
|
||||
/\ B B 1
|
||||
0 1 C 011
|
||||
/ \ D 010
|
||||
A /\
|
||||
0 1
|
||||
/ \
|
||||
D C
|
||||
|
||||
A parser can decode the next symbol from an encoded input
|
||||
stream by walking down the tree from the root, at each step
|
||||
choosing the edge corresponding to the next input bit.
|
||||
|
||||
Given an alphabet with known symbol frequencies, the Huffman
|
||||
algorithm allows the construction of an optimal prefix code
|
||||
(one which represents strings with those symbol frequencies
|
||||
using the fewest bits of any possible prefix codes for that
|
||||
alphabet). Such a code is called a Huffman code. (See
|
||||
reference [1] in Chapter 5, references for additional
|
||||
information on Huffman codes.)
|
||||
|
||||
Note that in the "deflate" format, the Huffman codes for the
|
||||
various alphabets must not exceed certain maximum code lengths.
|
||||
This constraint complicates the algorithm for computing code
|
||||
lengths from symbol frequencies. Again, see Chapter 5,
|
||||
references for details.
|
||||
|
||||
3.2.2. Use of Huffman coding in the "deflate" format
|
||||
|
||||
The Huffman codes used for each alphabet in the "deflate"
|
||||
format have two additional rules:
|
||||
|
||||
* All codes of a given bit length have lexicographically
|
||||
consecutive values, in the same order as the symbols
|
||||
they represent;
|
||||
|
||||
* Shorter codes lexicographically precede longer codes.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 7]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
We could recode the example above to follow this rule as
|
||||
follows, assuming that the order of the alphabet is ABCD:
|
||||
|
||||
Symbol Code
|
||||
------ ----
|
||||
A 10
|
||||
B 0
|
||||
C 110
|
||||
D 111
|
||||
|
||||
I.e., 0 precedes 10 which precedes 11x, and 110 and 111 are
|
||||
lexicographically consecutive.
|
||||
|
||||
Given this rule, we can define the Huffman code for an alphabet
|
||||
just by giving the bit lengths of the codes for each symbol of
|
||||
the alphabet in order; this is sufficient to determine the
|
||||
actual codes. In our example, the code is completely defined
|
||||
by the sequence of bit lengths (2, 1, 3, 3). The following
|
||||
algorithm generates the codes as integers, intended to be read
|
||||
from most- to least-significant bit. The code lengths are
|
||||
initially in tree[I].Len; the codes are produced in
|
||||
tree[I].Code.
|
||||
|
||||
1) Count the number of codes for each code length. Let
|
||||
bl_count[N] be the number of codes of length N, N >= 1.
|
||||
|
||||
2) Find the numerical value of the smallest code for each
|
||||
code length:
|
||||
|
||||
code = 0;
|
||||
bl_count[0] = 0;
|
||||
for (bits = 1; bits <= MAX_BITS; bits++) {
|
||||
code = (code + bl_count[bits-1]) << 1;
|
||||
next_code[bits] = code;
|
||||
}
|
||||
|
||||
3) Assign numerical values to all codes, using consecutive
|
||||
values for all codes of the same length with the base
|
||||
values determined at step 2. Codes that are never used
|
||||
(which have a bit length of zero) must not be assigned a
|
||||
value.
|
||||
|
||||
for (n = 0; n <= max_code; n++) {
|
||||
len = tree[n].Len;
|
||||
if (len != 0) {
|
||||
tree[n].Code = next_code[len];
|
||||
next_code[len]++;
|
||||
}
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 8]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
}
|
||||
|
||||
Example:
|
||||
|
||||
Consider the alphabet ABCDEFGH, with bit lengths (3, 3, 3, 3,
|
||||
3, 2, 4, 4). After step 1, we have:
|
||||
|
||||
N bl_count[N]
|
||||
- -----------
|
||||
2 1
|
||||
3 5
|
||||
4 2
|
||||
|
||||
Step 2 computes the following next_code values:
|
||||
|
||||
N next_code[N]
|
||||
- ------------
|
||||
1 0
|
||||
2 0
|
||||
3 2
|
||||
4 14
|
||||
|
||||
Step 3 produces the following code values:
|
||||
|
||||
Symbol Length Code
|
||||
------ ------ ----
|
||||
A 3 010
|
||||
B 3 011
|
||||
C 3 100
|
||||
D 3 101
|
||||
E 3 110
|
||||
F 2 00
|
||||
G 4 1110
|
||||
H 4 1111
|
||||
|
||||
3.2.3. Details of block format
|
||||
|
||||
Each block of compressed data begins with 3 header bits
|
||||
containing the following data:
|
||||
|
||||
first bit BFINAL
|
||||
next 2 bits BTYPE
|
||||
|
||||
Note that the header bits do not necessarily begin on a byte
|
||||
boundary, since a block does not necessarily occupy an integral
|
||||
number of bytes.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 9]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
BFINAL is set if and only if this is the last block of the data
|
||||
set.
|
||||
|
||||
BTYPE specifies how the data are compressed, as follows:
|
||||
|
||||
00 - no compression
|
||||
01 - compressed with fixed Huffman codes
|
||||
10 - compressed with dynamic Huffman codes
|
||||
11 - reserved (error)
|
||||
|
||||
The only difference between the two compressed cases is how the
|
||||
Huffman codes for the literal/length and distance alphabets are
|
||||
defined.
|
||||
|
||||
In all cases, the decoding algorithm for the actual data is as
|
||||
follows:
|
||||
|
||||
do
|
||||
read block header from input stream.
|
||||
if stored with no compression
|
||||
skip any remaining bits in current partially
|
||||
processed byte
|
||||
read LEN and NLEN (see next section)
|
||||
copy LEN bytes of data to output
|
||||
otherwise
|
||||
if compressed with dynamic Huffman codes
|
||||
read representation of code trees (see
|
||||
subsection below)
|
||||
loop (until end of block code recognized)
|
||||
decode literal/length value from input stream
|
||||
if value < 256
|
||||
copy value (literal byte) to output stream
|
||||
otherwise
|
||||
if value = end of block (256)
|
||||
break from loop
|
||||
otherwise (value = 257..285)
|
||||
decode distance from input stream
|
||||
|
||||
move backwards distance bytes in the output
|
||||
stream, and copy length bytes from this
|
||||
position to the output stream.
|
||||
end loop
|
||||
while not last block
|
||||
|
||||
Note that a duplicated string reference may refer to a string
|
||||
in a previous block; i.e., the backward distance may cross one
|
||||
or more block boundaries. However a distance cannot refer past
|
||||
the beginning of the output stream. (An application using a
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 10]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
preset dictionary might discard part of the output stream; a
|
||||
distance can refer to that part of the output stream anyway)
|
||||
Note also that the referenced string may overlap the current
|
||||
position; for example, if the last 2 bytes decoded have values
|
||||
X and Y, a string reference with <length = 5, distance = 2>
|
||||
adds X,Y,X,Y,X to the output stream.
|
||||
|
||||
We now specify each compression method in turn.
|
||||
|
||||
3.2.4. Non-compressed blocks (BTYPE=00)
|
||||
|
||||
Any bits of input up to the next byte boundary are ignored.
|
||||
The rest of the block consists of the following information:
|
||||
|
||||
0 1 2 3 4...
|
||||
+---+---+---+---+================================+
|
||||
| LEN | NLEN |... LEN bytes of literal data...|
|
||||
+---+---+---+---+================================+
|
||||
|
||||
LEN is the number of data bytes in the block. NLEN is the
|
||||
one's complement of LEN.
|
||||
|
||||
3.2.5. Compressed blocks (length and distance codes)
|
||||
|
||||
As noted above, encoded data blocks in the "deflate" format
|
||||
consist of sequences of symbols drawn from three conceptually
|
||||
distinct alphabets: either literal bytes, from the alphabet of
|
||||
byte values (0..255), or <length, backward distance> pairs,
|
||||
where the length is drawn from (3..258) and the distance is
|
||||
drawn from (1..32,768). In fact, the literal and length
|
||||
alphabets are merged into a single alphabet (0..285), where
|
||||
values 0..255 represent literal bytes, the value 256 indicates
|
||||
end-of-block, and values 257..285 represent length codes
|
||||
(possibly in conjunction with extra bits following the symbol
|
||||
code) as follows:
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 11]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
Extra Extra Extra
|
||||
Code Bits Length(s) Code Bits Lengths Code Bits Length(s)
|
||||
---- ---- ------ ---- ---- ------- ---- ---- -------
|
||||
257 0 3 267 1 15,16 277 4 67-82
|
||||
258 0 4 268 1 17,18 278 4 83-98
|
||||
259 0 5 269 2 19-22 279 4 99-114
|
||||
260 0 6 270 2 23-26 280 4 115-130
|
||||
261 0 7 271 2 27-30 281 5 131-162
|
||||
262 0 8 272 2 31-34 282 5 163-194
|
||||
263 0 9 273 3 35-42 283 5 195-226
|
||||
264 0 10 274 3 43-50 284 5 227-257
|
||||
265 1 11,12 275 3 51-58 285 0 258
|
||||
266 1 13,14 276 3 59-66
|
||||
|
||||
The extra bits should be interpreted as a machine integer
|
||||
stored with the most-significant bit first, e.g., bits 1110
|
||||
represent the value 14.
|
||||
|
||||
Extra Extra Extra
|
||||
Code Bits Dist Code Bits Dist Code Bits Distance
|
||||
---- ---- ---- ---- ---- ------ ---- ---- --------
|
||||
0 0 1 10 4 33-48 20 9 1025-1536
|
||||
1 0 2 11 4 49-64 21 9 1537-2048
|
||||
2 0 3 12 5 65-96 22 10 2049-3072
|
||||
3 0 4 13 5 97-128 23 10 3073-4096
|
||||
4 1 5,6 14 6 129-192 24 11 4097-6144
|
||||
5 1 7,8 15 6 193-256 25 11 6145-8192
|
||||
6 2 9-12 16 7 257-384 26 12 8193-12288
|
||||
7 2 13-16 17 7 385-512 27 12 12289-16384
|
||||
8 3 17-24 18 8 513-768 28 13 16385-24576
|
||||
9 3 25-32 19 8 769-1024 29 13 24577-32768
|
||||
|
||||
3.2.6. Compression with fixed Huffman codes (BTYPE=01)
|
||||
|
||||
The Huffman codes for the two alphabets are fixed, and are not
|
||||
represented explicitly in the data. The Huffman code lengths
|
||||
for the literal/length alphabet are:
|
||||
|
||||
Lit Value Bits Codes
|
||||
--------- ---- -----
|
||||
0 - 143 8 00110000 through
|
||||
10111111
|
||||
144 - 255 9 110010000 through
|
||||
111111111
|
||||
256 - 279 7 0000000 through
|
||||
0010111
|
||||
280 - 287 8 11000000 through
|
||||
11000111
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 12]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
The code lengths are sufficient to generate the actual codes,
|
||||
as described above; we show the codes in the table for added
|
||||
clarity. Literal/length values 286-287 will never actually
|
||||
occur in the compressed data, but participate in the code
|
||||
construction.
|
||||
|
||||
Distance codes 0-31 are represented by (fixed-length) 5-bit
|
||||
codes, with possible additional bits as shown in the table
|
||||
shown in Paragraph 3.2.5, above. Note that distance codes 30-
|
||||
31 will never actually occur in the compressed data.
|
||||
|
||||
3.2.7. Compression with dynamic Huffman codes (BTYPE=10)
|
||||
|
||||
The Huffman codes for the two alphabets appear in the block
|
||||
immediately after the header bits and before the actual
|
||||
compressed data, first the literal/length code and then the
|
||||
distance code. Each code is defined by a sequence of code
|
||||
lengths, as discussed in Paragraph 3.2.2, above. For even
|
||||
greater compactness, the code length sequences themselves are
|
||||
compressed using a Huffman code. The alphabet for code lengths
|
||||
is as follows:
|
||||
|
||||
0 - 15: Represent code lengths of 0 - 15
|
||||
16: Copy the previous code length 3 - 6 times.
|
||||
The next 2 bits indicate repeat length
|
||||
(0 = 3, ... , 3 = 6)
|
||||
Example: Codes 8, 16 (+2 bits 11),
|
||||
16 (+2 bits 10) will expand to
|
||||
12 code lengths of 8 (1 + 6 + 5)
|
||||
17: Repeat a code length of 0 for 3 - 10 times.
|
||||
(3 bits of length)
|
||||
18: Repeat a code length of 0 for 11 - 138 times
|
||||
(7 bits of length)
|
||||
|
||||
A code length of 0 indicates that the corresponding symbol in
|
||||
the literal/length or distance alphabet will not occur in the
|
||||
block, and should not participate in the Huffman code
|
||||
construction algorithm given earlier. If only one distance
|
||||
code is used, it is encoded using one bit, not zero bits; in
|
||||
this case there is a single code length of one, with one unused
|
||||
code. One distance code of zero bits means that there are no
|
||||
distance codes used at all (the data is all literals).
|
||||
|
||||
We can now define the format of the block:
|
||||
|
||||
5 Bits: HLIT, # of Literal/Length codes - 257 (257 - 286)
|
||||
5 Bits: HDIST, # of Distance codes - 1 (1 - 32)
|
||||
4 Bits: HCLEN, # of Code Length codes - 4 (4 - 19)
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 13]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
(HCLEN + 4) x 3 bits: code lengths for the code length
|
||||
alphabet given just above, in the order: 16, 17, 18,
|
||||
0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15
|
||||
|
||||
These code lengths are interpreted as 3-bit integers
|
||||
(0-7); as above, a code length of 0 means the
|
||||
corresponding symbol (literal/length or distance code
|
||||
length) is not used.
|
||||
|
||||
HLIT + 257 code lengths for the literal/length alphabet,
|
||||
encoded using the code length Huffman code
|
||||
|
||||
HDIST + 1 code lengths for the distance alphabet,
|
||||
encoded using the code length Huffman code
|
||||
|
||||
The actual compressed data of the block,
|
||||
encoded using the literal/length and distance Huffman
|
||||
codes
|
||||
|
||||
The literal/length symbol 256 (end of data),
|
||||
encoded using the literal/length Huffman code
|
||||
|
||||
The code length repeat codes can cross from HLIT + 257 to the
|
||||
HDIST + 1 code lengths. In other words, all code lengths form
|
||||
a single sequence of HLIT + HDIST + 258 values.
|
||||
|
||||
3.3. Compliance
|
||||
|
||||
A compressor may limit further the ranges of values specified in
|
||||
the previous section and still be compliant; for example, it may
|
||||
limit the range of backward pointers to some value smaller than
|
||||
32K. Similarly, a compressor may limit the size of blocks so that
|
||||
a compressible block fits in memory.
|
||||
|
||||
A compliant decompressor must accept the full range of possible
|
||||
values defined in the previous section, and must accept blocks of
|
||||
arbitrary size.
|
||||
|
||||
4. Compression algorithm details
|
||||
|
||||
While it is the intent of this document to define the "deflate"
|
||||
compressed data format without reference to any particular
|
||||
compression algorithm, the format is related to the compressed
|
||||
formats produced by LZ77 (Lempel-Ziv 1977, see reference [2] below);
|
||||
since many variations of LZ77 are patented, it is strongly
|
||||
recommended that the implementor of a compressor follow the general
|
||||
algorithm presented here, which is known not to be patented per se.
|
||||
The material in this section is not part of the definition of the
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 14]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
specification per se, and a compressor need not follow it in order to
|
||||
be compliant.
|
||||
|
||||
The compressor terminates a block when it determines that starting a
|
||||
new block with fresh trees would be useful, or when the block size
|
||||
fills up the compressor's block buffer.
|
||||
|
||||
The compressor uses a chained hash table to find duplicated strings,
|
||||
using a hash function that operates on 3-byte sequences. At any
|
||||
given point during compression, let XYZ be the next 3 input bytes to
|
||||
be examined (not necessarily all different, of course). First, the
|
||||
compressor examines the hash chain for XYZ. If the chain is empty,
|
||||
the compressor simply writes out X as a literal byte and advances one
|
||||
byte in the input. If the hash chain is not empty, indicating that
|
||||
the sequence XYZ (or, if we are unlucky, some other 3 bytes with the
|
||||
same hash function value) has occurred recently, the compressor
|
||||
compares all strings on the XYZ hash chain with the actual input data
|
||||
sequence starting at the current point, and selects the longest
|
||||
match.
|
||||
|
||||
The compressor searches the hash chains starting with the most recent
|
||||
strings, to favor small distances and thus take advantage of the
|
||||
Huffman encoding. The hash chains are singly linked. There are no
|
||||
deletions from the hash chains; the algorithm simply discards matches
|
||||
that are too old. To avoid a worst-case situation, very long hash
|
||||
chains are arbitrarily truncated at a certain length, determined by a
|
||||
run-time parameter.
|
||||
|
||||
To improve overall compression, the compressor optionally defers the
|
||||
selection of matches ("lazy matching"): after a match of length N has
|
||||
been found, the compressor searches for a longer match starting at
|
||||
the next input byte. If it finds a longer match, it truncates the
|
||||
previous match to a length of one (thus producing a single literal
|
||||
byte) and then emits the longer match. Otherwise, it emits the
|
||||
original match, and, as described above, advances N bytes before
|
||||
continuing.
|
||||
|
||||
Run-time parameters also control this "lazy match" procedure. If
|
||||
compression ratio is most important, the compressor attempts a
|
||||
complete second search regardless of the length of the first match.
|
||||
In the normal case, if the current match is "long enough", the
|
||||
compressor reduces the search for a longer match, thus speeding up
|
||||
the process. If speed is most important, the compressor inserts new
|
||||
strings in the hash table only when no match was found, or when the
|
||||
match is not "too long". This degrades the compression ratio but
|
||||
saves time since there are both fewer insertions and fewer searches.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 15]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
5. References
|
||||
|
||||
[1] Huffman, D. A., "A Method for the Construction of Minimum
|
||||
Redundancy Codes", Proceedings of the Institute of Radio
|
||||
Engineers, September 1952, Volume 40, Number 9, pp. 1098-1101.
|
||||
|
||||
[2] Ziv J., Lempel A., "A Universal Algorithm for Sequential Data
|
||||
Compression", IEEE Transactions on Information Theory, Vol. 23,
|
||||
No. 3, pp. 337-343.
|
||||
|
||||
[3] Gailly, J.-L., and Adler, M., ZLIB documentation and sources,
|
||||
available in ftp://ftp.uu.net/pub/archiving/zip/doc/
|
||||
|
||||
[4] Gailly, J.-L., and Adler, M., GZIP documentation and sources,
|
||||
available as gzip-*.tar in ftp://prep.ai.mit.edu/pub/gnu/
|
||||
|
||||
[5] Schwartz, E. S., and Kallick, B. "Generating a canonical prefix
|
||||
encoding." Comm. ACM, 7,3 (Mar. 1964), pp. 166-169.
|
||||
|
||||
[6] Hirschberg and Lelewer, "Efficient decoding of prefix codes,"
|
||||
Comm. ACM, 33,4, April 1990, pp. 449-459.
|
||||
|
||||
6. Security Considerations
|
||||
|
||||
Any data compression method involves the reduction of redundancy in
|
||||
the data. Consequently, any corruption of the data is likely to have
|
||||
severe effects and be difficult to correct. Uncompressed text, on
|
||||
the other hand, will probably still be readable despite the presence
|
||||
of some corrupted bytes.
|
||||
|
||||
It is recommended that systems using this data format provide some
|
||||
means of validating the integrity of the compressed data. See
|
||||
reference [3], for example.
|
||||
|
||||
7. Source code
|
||||
|
||||
Source code for a C language implementation of a "deflate" compliant
|
||||
compressor and decompressor is available within the zlib package at
|
||||
ftp://ftp.uu.net/pub/archiving/zip/zlib/.
|
||||
|
||||
8. Acknowledgements
|
||||
|
||||
Trademarks cited in this document are the property of their
|
||||
respective owners.
|
||||
|
||||
Phil Katz designed the deflate format. Jean-Loup Gailly and Mark
|
||||
Adler wrote the related software described in this specification.
|
||||
Glenn Randers-Pehrson converted this document to RFC and HTML format.
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 16]
|
||||
|
||||
RFC 1951 DEFLATE Compressed Data Format Specification May 1996
|
||||
|
||||
|
||||
9. Author's Address
|
||||
|
||||
L. Peter Deutsch
|
||||
Aladdin Enterprises
|
||||
203 Santa Margarita Ave.
|
||||
Menlo Park, CA 94025
|
||||
|
||||
Phone: (415) 322-0103 (AM only)
|
||||
FAX: (415) 322-1734
|
||||
EMail: <ghost@aladdin.com>
|
||||
|
||||
Questions about the technical content of this specification can be
|
||||
sent by email to:
|
||||
|
||||
Jean-Loup Gailly <gzip@prep.ai.mit.edu> and
|
||||
Mark Adler <madler@alumni.caltech.edu>
|
||||
|
||||
Editorial comments on this specification can be sent by email to:
|
||||
|
||||
L. Peter Deutsch <ghost@aladdin.com> and
|
||||
Glenn Randers-Pehrson <randeg@alumni.rpi.edu>
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 17]
|
||||
|
||||
@@ -0,0 +1,675 @@
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Network Working Group P. Deutsch
|
||||
Request for Comments: 1952 Aladdin Enterprises
|
||||
Category: Informational May 1996
|
||||
|
||||
|
||||
GZIP file format specification version 4.3
|
||||
|
||||
Status of This Memo
|
||||
|
||||
This memo provides information for the Internet community. This memo
|
||||
does not specify an Internet standard of any kind. Distribution of
|
||||
this memo is unlimited.
|
||||
|
||||
IESG Note:
|
||||
|
||||
The IESG takes no position on the validity of any Intellectual
|
||||
Property Rights statements contained in this document.
|
||||
|
||||
Notices
|
||||
|
||||
Copyright (c) 1996 L. Peter Deutsch
|
||||
|
||||
Permission is granted to copy and distribute this document for any
|
||||
purpose and without charge, including translations into other
|
||||
languages and incorporation into compilations, provided that the
|
||||
copyright notice and this notice are preserved, and that any
|
||||
substantive changes or deletions from the original are clearly
|
||||
marked.
|
||||
|
||||
A pointer to the latest version of this and related documentation in
|
||||
HTML format can be found at the URL
|
||||
<ftp://ftp.uu.net/graphics/png/documents/zlib/zdoc-index.html>.
|
||||
|
||||
Abstract
|
||||
|
||||
This specification defines a lossless compressed data format that is
|
||||
compatible with the widely used GZIP utility. The format includes a
|
||||
cyclic redundancy check value for detecting data corruption. The
|
||||
format presently uses the DEFLATE method of compression but can be
|
||||
easily extended to use other compression methods. The format can be
|
||||
implemented readily in a manner not covered by patents.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 1]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
Table of Contents
|
||||
|
||||
1. Introduction ................................................... 2
|
||||
1.1. Purpose ................................................... 2
|
||||
1.2. Intended audience ......................................... 3
|
||||
1.3. Scope ..................................................... 3
|
||||
1.4. Compliance ................................................ 3
|
||||
1.5. Definitions of terms and conventions used ................. 3
|
||||
1.6. Changes from previous versions ............................ 3
|
||||
2. Detailed specification ......................................... 4
|
||||
2.1. Overall conventions ....................................... 4
|
||||
2.2. File format ............................................... 5
|
||||
2.3. Member format ............................................. 5
|
||||
2.3.1. Member header and trailer ........................... 6
|
||||
2.3.1.1. Extra field ................................... 8
|
||||
2.3.1.2. Compliance .................................... 9
|
||||
3. References .................................................. 9
|
||||
4. Security Considerations .................................... 10
|
||||
5. Acknowledgements ........................................... 10
|
||||
6. Author's Address ........................................... 10
|
||||
7. Appendix: Jean-Loup Gailly's gzip utility .................. 11
|
||||
8. Appendix: Sample CRC Code .................................. 11
|
||||
|
||||
1. Introduction
|
||||
|
||||
1.1. Purpose
|
||||
|
||||
The purpose of this specification is to define a lossless
|
||||
compressed data format that:
|
||||
|
||||
* Is independent of CPU type, operating system, file system,
|
||||
and character set, and hence can be used for interchange;
|
||||
* Can compress or decompress a data stream (as opposed to a
|
||||
randomly accessible file) to produce another data stream,
|
||||
using only an a priori bounded amount of intermediate
|
||||
storage, and hence can be used in data communications or
|
||||
similar structures such as Unix filters;
|
||||
* Compresses data with efficiency comparable to the best
|
||||
currently available general-purpose compression methods,
|
||||
and in particular considerably better than the "compress"
|
||||
program;
|
||||
* Can be implemented readily in a manner not covered by
|
||||
patents, and hence can be practiced freely;
|
||||
* Is compatible with the file format produced by the current
|
||||
widely used gzip utility, in that conforming decompressors
|
||||
will be able to read data produced by the existing gzip
|
||||
compressor.
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 2]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
The data format defined by this specification does not attempt to:
|
||||
|
||||
* Provide random access to compressed data;
|
||||
* Compress specialized data (e.g., raster graphics) as well as
|
||||
the best currently available specialized algorithms.
|
||||
|
||||
1.2. Intended audience
|
||||
|
||||
This specification is intended for use by implementors of software
|
||||
to compress data into gzip format and/or decompress data from gzip
|
||||
format.
|
||||
|
||||
The text of the specification assumes a basic background in
|
||||
programming at the level of bits and other primitive data
|
||||
representations.
|
||||
|
||||
1.3. Scope
|
||||
|
||||
The specification specifies a compression method and a file format
|
||||
(the latter assuming only that a file can store a sequence of
|
||||
arbitrary bytes). It does not specify any particular interface to
|
||||
a file system or anything about character sets or encodings
|
||||
(except for file names and comments, which are optional).
|
||||
|
||||
1.4. Compliance
|
||||
|
||||
Unless otherwise indicated below, a compliant decompressor must be
|
||||
able to accept and decompress any file that conforms to all the
|
||||
specifications presented here; a compliant compressor must produce
|
||||
files that conform to all the specifications presented here. The
|
||||
material in the appendices is not part of the specification per se
|
||||
and is not relevant to compliance.
|
||||
|
||||
1.5. Definitions of terms and conventions used
|
||||
|
||||
byte: 8 bits stored or transmitted as a unit (same as an octet).
|
||||
(For this specification, a byte is exactly 8 bits, even on
|
||||
machines which store a character on a number of bits different
|
||||
from 8.) See below for the numbering of bits within a byte.
|
||||
|
||||
1.6. Changes from previous versions
|
||||
|
||||
There have been no technical changes to the gzip format since
|
||||
version 4.1 of this specification. In version 4.2, some
|
||||
terminology was changed, and the sample CRC code was rewritten for
|
||||
clarity and to eliminate the requirement for the caller to do pre-
|
||||
and post-conditioning. Version 4.3 is a conversion of the
|
||||
specification to RFC style.
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 3]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
2. Detailed specification
|
||||
|
||||
2.1. Overall conventions
|
||||
|
||||
In the diagrams below, a box like this:
|
||||
|
||||
+---+
|
||||
| | <-- the vertical bars might be missing
|
||||
+---+
|
||||
|
||||
represents one byte; a box like this:
|
||||
|
||||
+==============+
|
||||
| |
|
||||
+==============+
|
||||
|
||||
represents a variable number of bytes.
|
||||
|
||||
Bytes stored within a computer do not have a "bit order", since
|
||||
they are always treated as a unit. However, a byte considered as
|
||||
an integer between 0 and 255 does have a most- and least-
|
||||
significant bit, and since we write numbers with the most-
|
||||
significant digit on the left, we also write bytes with the most-
|
||||
significant bit on the left. In the diagrams below, we number the
|
||||
bits of a byte so that bit 0 is the least-significant bit, i.e.,
|
||||
the bits are numbered:
|
||||
|
||||
+--------+
|
||||
|76543210|
|
||||
+--------+
|
||||
|
||||
This document does not address the issue of the order in which
|
||||
bits of a byte are transmitted on a bit-sequential medium, since
|
||||
the data format described here is byte- rather than bit-oriented.
|
||||
|
||||
Within a computer, a number may occupy multiple bytes. All
|
||||
multi-byte numbers in the format described here are stored with
|
||||
the least-significant byte first (at the lower memory address).
|
||||
For example, the decimal number 520 is stored as:
|
||||
|
||||
0 1
|
||||
+--------+--------+
|
||||
|00001000|00000010|
|
||||
+--------+--------+
|
||||
^ ^
|
||||
| |
|
||||
| + more significant byte = 2 x 256
|
||||
+ less significant byte = 8
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 4]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
2.2. File format
|
||||
|
||||
A gzip file consists of a series of "members" (compressed data
|
||||
sets). The format of each member is specified in the following
|
||||
section. The members simply appear one after another in the file,
|
||||
with no additional information before, between, or after them.
|
||||
|
||||
2.3. Member format
|
||||
|
||||
Each member has the following structure:
|
||||
|
||||
+---+---+---+---+---+---+---+---+---+---+
|
||||
|ID1|ID2|CM |FLG| MTIME |XFL|OS | (more-->)
|
||||
+---+---+---+---+---+---+---+---+---+---+
|
||||
|
||||
(if FLG.FEXTRA set)
|
||||
|
||||
+---+---+=================================+
|
||||
| XLEN |...XLEN bytes of "extra field"...| (more-->)
|
||||
+---+---+=================================+
|
||||
|
||||
(if FLG.FNAME set)
|
||||
|
||||
+=========================================+
|
||||
|...original file name, zero-terminated...| (more-->)
|
||||
+=========================================+
|
||||
|
||||
(if FLG.FCOMMENT set)
|
||||
|
||||
+===================================+
|
||||
|...file comment, zero-terminated...| (more-->)
|
||||
+===================================+
|
||||
|
||||
(if FLG.FHCRC set)
|
||||
|
||||
+---+---+
|
||||
| CRC16 |
|
||||
+---+---+
|
||||
|
||||
+=======================+
|
||||
|...compressed blocks...| (more-->)
|
||||
+=======================+
|
||||
|
||||
0 1 2 3 4 5 6 7
|
||||
+---+---+---+---+---+---+---+---+
|
||||
| CRC32 | ISIZE |
|
||||
+---+---+---+---+---+---+---+---+
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 5]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
2.3.1. Member header and trailer
|
||||
|
||||
ID1 (IDentification 1)
|
||||
ID2 (IDentification 2)
|
||||
These have the fixed values ID1 = 31 (0x1f, \037), ID2 = 139
|
||||
(0x8b, \213), to identify the file as being in gzip format.
|
||||
|
||||
CM (Compression Method)
|
||||
This identifies the compression method used in the file. CM
|
||||
= 0-7 are reserved. CM = 8 denotes the "deflate"
|
||||
compression method, which is the one customarily used by
|
||||
gzip and which is documented elsewhere.
|
||||
|
||||
FLG (FLaGs)
|
||||
This flag byte is divided into individual bits as follows:
|
||||
|
||||
bit 0 FTEXT
|
||||
bit 1 FHCRC
|
||||
bit 2 FEXTRA
|
||||
bit 3 FNAME
|
||||
bit 4 FCOMMENT
|
||||
bit 5 reserved
|
||||
bit 6 reserved
|
||||
bit 7 reserved
|
||||
|
||||
If FTEXT is set, the file is probably ASCII text. This is
|
||||
an optional indication, which the compressor may set by
|
||||
checking a small amount of the input data to see whether any
|
||||
non-ASCII characters are present. In case of doubt, FTEXT
|
||||
is cleared, indicating binary data. For systems which have
|
||||
different file formats for ascii text and binary data, the
|
||||
decompressor can use FTEXT to choose the appropriate format.
|
||||
We deliberately do not specify the algorithm used to set
|
||||
this bit, since a compressor always has the option of
|
||||
leaving it cleared and a decompressor always has the option
|
||||
of ignoring it and letting some other program handle issues
|
||||
of data conversion.
|
||||
|
||||
If FHCRC is set, a CRC16 for the gzip header is present,
|
||||
immediately before the compressed data. The CRC16 consists
|
||||
of the two least significant bytes of the CRC32 for all
|
||||
bytes of the gzip header up to and not including the CRC16.
|
||||
[The FHCRC bit was never set by versions of gzip up to
|
||||
1.2.4, even though it was documented with a different
|
||||
meaning in gzip 1.2.4.]
|
||||
|
||||
If FEXTRA is set, optional extra fields are present, as
|
||||
described in a following section.
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 6]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
If FNAME is set, an original file name is present,
|
||||
terminated by a zero byte. The name must consist of ISO
|
||||
8859-1 (LATIN-1) characters; on operating systems using
|
||||
EBCDIC or any other character set for file names, the name
|
||||
must be translated to the ISO LATIN-1 character set. This
|
||||
is the original name of the file being compressed, with any
|
||||
directory components removed, and, if the file being
|
||||
compressed is on a file system with case insensitive names,
|
||||
forced to lower case. There is no original file name if the
|
||||
data was compressed from a source other than a named file;
|
||||
for example, if the source was stdin on a Unix system, there
|
||||
is no file name.
|
||||
|
||||
If FCOMMENT is set, a zero-terminated file comment is
|
||||
present. This comment is not interpreted; it is only
|
||||
intended for human consumption. The comment must consist of
|
||||
ISO 8859-1 (LATIN-1) characters. Line breaks should be
|
||||
denoted by a single line feed character (10 decimal).
|
||||
|
||||
Reserved FLG bits must be zero.
|
||||
|
||||
MTIME (Modification TIME)
|
||||
This gives the most recent modification time of the original
|
||||
file being compressed. The time is in Unix format, i.e.,
|
||||
seconds since 00:00:00 GMT, Jan. 1, 1970. (Note that this
|
||||
may cause problems for MS-DOS and other systems that use
|
||||
local rather than Universal time.) If the compressed data
|
||||
did not come from a file, MTIME is set to the time at which
|
||||
compression started. MTIME = 0 means no time stamp is
|
||||
available.
|
||||
|
||||
XFL (eXtra FLags)
|
||||
These flags are available for use by specific compression
|
||||
methods. The "deflate" method (CM = 8) sets these flags as
|
||||
follows:
|
||||
|
||||
XFL = 2 - compressor used maximum compression,
|
||||
slowest algorithm
|
||||
XFL = 4 - compressor used fastest algorithm
|
||||
|
||||
OS (Operating System)
|
||||
This identifies the type of file system on which compression
|
||||
took place. This may be useful in determining end-of-line
|
||||
convention for text files. The currently defined values are
|
||||
as follows:
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 7]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
0 - FAT filesystem (MS-DOS, OS/2, NT/Win32)
|
||||
1 - Amiga
|
||||
2 - VMS (or OpenVMS)
|
||||
3 - Unix
|
||||
4 - VM/CMS
|
||||
5 - Atari TOS
|
||||
6 - HPFS filesystem (OS/2, NT)
|
||||
7 - Macintosh
|
||||
8 - Z-System
|
||||
9 - CP/M
|
||||
10 - TOPS-20
|
||||
11 - NTFS filesystem (NT)
|
||||
12 - QDOS
|
||||
13 - Acorn RISCOS
|
||||
255 - unknown
|
||||
|
||||
XLEN (eXtra LENgth)
|
||||
If FLG.FEXTRA is set, this gives the length of the optional
|
||||
extra field. See below for details.
|
||||
|
||||
CRC32 (CRC-32)
|
||||
This contains a Cyclic Redundancy Check value of the
|
||||
uncompressed data computed according to CRC-32 algorithm
|
||||
used in the ISO 3309 standard and in section 8.1.1.6.2 of
|
||||
ITU-T recommendation V.42. (See http://www.iso.ch for
|
||||
ordering ISO documents. See gopher://info.itu.ch for an
|
||||
online version of ITU-T V.42.)
|
||||
|
||||
ISIZE (Input SIZE)
|
||||
This contains the size of the original (uncompressed) input
|
||||
data modulo 2^32.
|
||||
|
||||
2.3.1.1. Extra field
|
||||
|
||||
If the FLG.FEXTRA bit is set, an "extra field" is present in
|
||||
the header, with total length XLEN bytes. It consists of a
|
||||
series of subfields, each of the form:
|
||||
|
||||
+---+---+---+---+==================================+
|
||||
|SI1|SI2| LEN |... LEN bytes of subfield data ...|
|
||||
+---+---+---+---+==================================+
|
||||
|
||||
SI1 and SI2 provide a subfield ID, typically two ASCII letters
|
||||
with some mnemonic value. Jean-Loup Gailly
|
||||
<gzip@prep.ai.mit.edu> is maintaining a registry of subfield
|
||||
IDs; please send him any subfield ID you wish to use. Subfield
|
||||
IDs with SI2 = 0 are reserved for future use. The following
|
||||
IDs are currently defined:
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 8]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
SI1 SI2 Data
|
||||
---------- ---------- ----
|
||||
0x41 ('A') 0x70 ('P') Apollo file type information
|
||||
|
||||
LEN gives the length of the subfield data, excluding the 4
|
||||
initial bytes.
|
||||
|
||||
2.3.1.2. Compliance
|
||||
|
||||
A compliant compressor must produce files with correct ID1,
|
||||
ID2, CM, CRC32, and ISIZE, but may set all the other fields in
|
||||
the fixed-length part of the header to default values (255 for
|
||||
OS, 0 for all others). The compressor must set all reserved
|
||||
bits to zero.
|
||||
|
||||
A compliant decompressor must check ID1, ID2, and CM, and
|
||||
provide an error indication if any of these have incorrect
|
||||
values. It must examine FEXTRA/XLEN, FNAME, FCOMMENT and FHCRC
|
||||
at least so it can skip over the optional fields if they are
|
||||
present. It need not examine any other part of the header or
|
||||
trailer; in particular, a decompressor may ignore FTEXT and OS
|
||||
and always produce binary output, and still be compliant. A
|
||||
compliant decompressor must give an error indication if any
|
||||
reserved bit is non-zero, since such a bit could indicate the
|
||||
presence of a new field that would cause subsequent data to be
|
||||
interpreted incorrectly.
|
||||
|
||||
3. References
|
||||
|
||||
[1] "Information Processing - 8-bit single-byte coded graphic
|
||||
character sets - Part 1: Latin alphabet No.1" (ISO 8859-1:1987).
|
||||
The ISO 8859-1 (Latin-1) character set is a superset of 7-bit
|
||||
ASCII. Files defining this character set are available as
|
||||
iso_8859-1.* in ftp://ftp.uu.net/graphics/png/documents/
|
||||
|
||||
[2] ISO 3309
|
||||
|
||||
[3] ITU-T recommendation V.42
|
||||
|
||||
[4] Deutsch, L.P.,"DEFLATE Compressed Data Format Specification",
|
||||
available in ftp://ftp.uu.net/pub/archiving/zip/doc/
|
||||
|
||||
[5] Gailly, J.-L., GZIP documentation, available as gzip-*.tar in
|
||||
ftp://prep.ai.mit.edu/pub/gnu/
|
||||
|
||||
[6] Sarwate, D.V., "Computation of Cyclic Redundancy Checks via Table
|
||||
Look-Up", Communications of the ACM, 31(8), pp.1008-1013.
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 9]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
[7] Schwaderer, W.D., "CRC Calculation", April 85 PC Tech Journal,
|
||||
pp.118-133.
|
||||
|
||||
[8] ftp://ftp.adelaide.edu.au/pub/rocksoft/papers/crc_v3.txt,
|
||||
describing the CRC concept.
|
||||
|
||||
4. Security Considerations
|
||||
|
||||
Any data compression method involves the reduction of redundancy in
|
||||
the data. Consequently, any corruption of the data is likely to have
|
||||
severe effects and be difficult to correct. Uncompressed text, on
|
||||
the other hand, will probably still be readable despite the presence
|
||||
of some corrupted bytes.
|
||||
|
||||
It is recommended that systems using this data format provide some
|
||||
means of validating the integrity of the compressed data, such as by
|
||||
setting and checking the CRC-32 check value.
|
||||
|
||||
5. Acknowledgements
|
||||
|
||||
Trademarks cited in this document are the property of their
|
||||
respective owners.
|
||||
|
||||
Jean-Loup Gailly designed the gzip format and wrote, with Mark Adler,
|
||||
the related software described in this specification. Glenn
|
||||
Randers-Pehrson converted this document to RFC and HTML format.
|
||||
|
||||
6. Author's Address
|
||||
|
||||
L. Peter Deutsch
|
||||
Aladdin Enterprises
|
||||
203 Santa Margarita Ave.
|
||||
Menlo Park, CA 94025
|
||||
|
||||
Phone: (415) 322-0103 (AM only)
|
||||
FAX: (415) 322-1734
|
||||
EMail: <ghost@aladdin.com>
|
||||
|
||||
Questions about the technical content of this specification can be
|
||||
sent by email to:
|
||||
|
||||
Jean-Loup Gailly <gzip@prep.ai.mit.edu> and
|
||||
Mark Adler <madler@alumni.caltech.edu>
|
||||
|
||||
Editorial comments on this specification can be sent by email to:
|
||||
|
||||
L. Peter Deutsch <ghost@aladdin.com> and
|
||||
Glenn Randers-Pehrson <randeg@alumni.rpi.edu>
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 10]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
7. Appendix: Jean-Loup Gailly's gzip utility
|
||||
|
||||
The most widely used implementation of gzip compression, and the
|
||||
original documentation on which this specification is based, were
|
||||
created by Jean-Loup Gailly <gzip@prep.ai.mit.edu>. Since this
|
||||
implementation is a de facto standard, we mention some more of its
|
||||
features here. Again, the material in this section is not part of
|
||||
the specification per se, and implementations need not follow it to
|
||||
be compliant.
|
||||
|
||||
When compressing or decompressing a file, gzip preserves the
|
||||
protection, ownership, and modification time attributes on the local
|
||||
file system, since there is no provision for representing protection
|
||||
attributes in the gzip file format itself. Since the file format
|
||||
includes a modification time, the gzip decompressor provides a
|
||||
command line switch that assigns the modification time from the file,
|
||||
rather than the local modification time of the compressed input, to
|
||||
the decompressed output.
|
||||
|
||||
8. Appendix: Sample CRC Code
|
||||
|
||||
The following sample code represents a practical implementation of
|
||||
the CRC (Cyclic Redundancy Check). (See also ISO 3309 and ITU-T V.42
|
||||
for a formal specification.)
|
||||
|
||||
The sample code is in the ANSI C programming language. Non C users
|
||||
may find it easier to read with these hints:
|
||||
|
||||
& Bitwise AND operator.
|
||||
^ Bitwise exclusive-OR operator.
|
||||
>> Bitwise right shift operator. When applied to an
|
||||
unsigned quantity, as here, right shift inserts zero
|
||||
bit(s) at the left.
|
||||
! Logical NOT operator.
|
||||
++ "n++" increments the variable n.
|
||||
0xNNN 0x introduces a hexadecimal (base 16) constant.
|
||||
Suffix L indicates a long value (at least 32 bits).
|
||||
|
||||
/* Table of CRCs of all 8-bit messages. */
|
||||
unsigned long crc_table[256];
|
||||
|
||||
/* Flag: has the table been computed? Initially false. */
|
||||
int crc_table_computed = 0;
|
||||
|
||||
/* Make the table for a fast CRC. */
|
||||
void make_crc_table(void)
|
||||
{
|
||||
unsigned long c;
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 11]
|
||||
|
||||
RFC 1952 GZIP File Format Specification May 1996
|
||||
|
||||
|
||||
int n, k;
|
||||
for (n = 0; n < 256; n++) {
|
||||
c = (unsigned long) n;
|
||||
for (k = 0; k < 8; k++) {
|
||||
if (c & 1) {
|
||||
c = 0xedb88320L ^ (c >> 1);
|
||||
} else {
|
||||
c = c >> 1;
|
||||
}
|
||||
}
|
||||
crc_table[n] = c;
|
||||
}
|
||||
crc_table_computed = 1;
|
||||
}
|
||||
|
||||
/*
|
||||
Update a running crc with the bytes buf[0..len-1] and return
|
||||
the updated crc. The crc should be initialized to zero. Pre- and
|
||||
post-conditioning (one's complement) is performed within this
|
||||
function so it shouldn't be done by the caller. Usage example:
|
||||
|
||||
unsigned long crc = 0L;
|
||||
|
||||
while (read_buffer(buffer, length) != EOF) {
|
||||
crc = update_crc(crc, buffer, length);
|
||||
}
|
||||
if (crc != original_crc) error();
|
||||
*/
|
||||
unsigned long update_crc(unsigned long crc,
|
||||
unsigned char *buf, int len)
|
||||
{
|
||||
unsigned long c = crc ^ 0xffffffffL;
|
||||
int n;
|
||||
|
||||
if (!crc_table_computed)
|
||||
make_crc_table();
|
||||
for (n = 0; n < len; n++) {
|
||||
c = crc_table[(c ^ buf[n]) & 0xff] ^ (c >> 8);
|
||||
}
|
||||
return c ^ 0xffffffffL;
|
||||
}
|
||||
|
||||
/* Return the CRC of the bytes buf[0..len-1]. */
|
||||
unsigned long crc(unsigned char *buf, int len)
|
||||
{
|
||||
return update_crc(0L, buf, len);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
Deutsch Informational [Page 12]
|
||||
|
||||
@@ -0,0 +1,107 @@
|
||||
A Fast Method for Identifying Plain Text Files
|
||||
==============================================
|
||||
|
||||
|
||||
Introduction
|
||||
------------
|
||||
|
||||
Given a file coming from an unknown source, it is sometimes desirable
|
||||
to find out whether the format of that file is plain text. Although
|
||||
this may appear like a simple task, a fully accurate detection of the
|
||||
file type requires heavy-duty semantic analysis on the file contents.
|
||||
It is, however, possible to obtain satisfactory results by employing
|
||||
various heuristics.
|
||||
|
||||
Previous versions of PKZip and other zip-compatible compression tools
|
||||
were using a crude detection scheme: if more than 80% (4/5) of the bytes
|
||||
found in a certain buffer are within the range [7..127], the file is
|
||||
labeled as plain text, otherwise it is labeled as binary. A prominent
|
||||
limitation of this scheme is the restriction to Latin-based alphabets.
|
||||
Other alphabets, like Greek, Cyrillic or Asian, make extensive use of
|
||||
the bytes within the range [128..255], and texts using these alphabets
|
||||
are most often misidentified by this scheme; in other words, the rate
|
||||
of false negatives is sometimes too high, which means that the recall
|
||||
is low. Another weakness of this scheme is a reduced precision, due to
|
||||
the false positives that may occur when binary files containing large
|
||||
amounts of textual characters are misidentified as plain text.
|
||||
|
||||
In this article we propose a new, simple detection scheme that features
|
||||
a much increased precision and a near-100% recall. This scheme is
|
||||
designed to work on ASCII, Unicode and other ASCII-derived alphabets,
|
||||
and it handles single-byte encodings (ISO-8859, MacRoman, KOI8, etc.)
|
||||
and variable-sized encodings (ISO-2022, UTF-8, etc.). Wider encodings
|
||||
(UCS-2/UTF-16 and UCS-4/UTF-32) are not handled, however.
|
||||
|
||||
|
||||
The Algorithm
|
||||
-------------
|
||||
|
||||
The algorithm works by dividing the set of bytecodes [0..255] into three
|
||||
categories:
|
||||
- The white list of textual bytecodes:
|
||||
9 (TAB), 10 (LF), 13 (CR), 32 (SPACE) to 255.
|
||||
- The gray list of tolerated bytecodes:
|
||||
7 (BEL), 8 (BS), 11 (VT), 12 (FF), 26 (SUB), 27 (ESC).
|
||||
- The black list of undesired, non-textual bytecodes:
|
||||
0 (NUL) to 6, 14 to 31.
|
||||
|
||||
If a file contains at least one byte that belongs to the white list and
|
||||
no byte that belongs to the black list, then the file is categorized as
|
||||
plain text; otherwise, it is categorized as binary. (The boundary case,
|
||||
when the file is empty, automatically falls into the latter category.)
|
||||
|
||||
|
||||
Rationale
|
||||
---------
|
||||
|
||||
The idea behind this algorithm relies on two observations.
|
||||
|
||||
The first observation is that, although the full range of 7-bit codes
|
||||
[0..127] is properly specified by the ASCII standard, most control
|
||||
characters in the range [0..31] are not used in practice. The only
|
||||
widely-used, almost universally-portable control codes are 9 (TAB),
|
||||
10 (LF) and 13 (CR). There are a few more control codes that are
|
||||
recognized on a reduced range of platforms and text viewers/editors:
|
||||
7 (BEL), 8 (BS), 11 (VT), 12 (FF), 26 (SUB) and 27 (ESC); but these
|
||||
codes are rarely (if ever) used alone, without being accompanied by
|
||||
some printable text. Even the newer, portable text formats such as
|
||||
XML avoid using control characters outside the list mentioned here.
|
||||
|
||||
The second observation is that most of the binary files tend to contain
|
||||
control characters, especially 0 (NUL). Even though the older text
|
||||
detection schemes observe the presence of non-ASCII codes from the range
|
||||
[128..255], the precision rarely has to suffer if this upper range is
|
||||
labeled as textual, because the files that are genuinely binary tend to
|
||||
contain both control characters and codes from the upper range. On the
|
||||
other hand, the upper range needs to be labeled as textual, because it
|
||||
is used by virtually all ASCII extensions. In particular, this range is
|
||||
used for encoding non-Latin scripts.
|
||||
|
||||
Since there is no counting involved, other than simply observing the
|
||||
presence or the absence of some byte values, the algorithm produces
|
||||
consistent results, regardless what alphabet encoding is being used.
|
||||
(If counting were involved, it could be possible to obtain different
|
||||
results on a text encoded, say, using ISO-8859-16 versus UTF-8.)
|
||||
|
||||
There is an extra category of plain text files that are "polluted" with
|
||||
one or more black-listed codes, either by mistake or by peculiar design
|
||||
considerations. In such cases, a scheme that tolerates a small fraction
|
||||
of black-listed codes would provide an increased recall (i.e. more true
|
||||
positives). This, however, incurs a reduced precision overall, since
|
||||
false positives are more likely to appear in binary files that contain
|
||||
large chunks of textual data. Furthermore, "polluted" plain text should
|
||||
be regarded as binary by general-purpose text detection schemes, because
|
||||
general-purpose text processing algorithms might not be applicable.
|
||||
Under this premise, it is safe to say that our detection method provides
|
||||
a near-100% recall.
|
||||
|
||||
Experiments have been run on many files coming from various platforms
|
||||
and applications. We tried plain text files, system logs, source code,
|
||||
formatted office documents, compiled object code, etc. The results
|
||||
confirm the optimistic assumptions about the capabilities of this
|
||||
algorithm.
|
||||
|
||||
|
||||
--
|
||||
Cosmin Truta
|
||||
Last updated: 2006-May-28
|
||||
@@ -260,6 +260,10 @@ Windows-only convenience
|
||||
functions for converting between UTF-8 and Windows strings
|
||||
based on the TCHAR type which is by convention
|
||||
a Unicode character on Windows NT.
|
||||
These functions are essentially wrappers around
|
||||
\fBTcl_UtfToExternalDString\fR and
|
||||
\fBTcl_ExternalToUtfDString\fR that convert to and from the
|
||||
Unicode encoding.
|
||||
.PP
|
||||
\fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR.
|
||||
Given an \fIencoding\fR, the return value is the \fIname\fR argument that
|
||||
|
||||
+5
-5
@@ -176,10 +176,10 @@ it is faster to execute the script directly.
|
||||
.TP 23
|
||||
\fBTCL_EVAL_GLOBAL\fR
|
||||
.
|
||||
If this flag is set, the script is evaluated in the global namespace instead of
|
||||
the current namespace and its variable context consists of global variables
|
||||
only (it ignores any Tcl procedures that are active).
|
||||
.\" TODO: document TCL_EVAL_INVOKE and TCL_EVAL_NOERR.
|
||||
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 that are active).
|
||||
|
||||
.SH "MISCELLANEOUS DETAILS"
|
||||
.PP
|
||||
@@ -205,7 +205,7 @@ 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_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR.
|
||||
from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.
|
||||
|
||||
.SH KEYWORDS
|
||||
execute, file, global, result, script, value
|
||||
|
||||
+2
-5
@@ -57,9 +57,6 @@ after the optional white space and sign are
|
||||
.QW \fB0x\fR
|
||||
then \fIsrc\fR is expected to be in hexadecimal form; otherwise,
|
||||
if the first such characters are
|
||||
.QW \fB0d\fR
|
||||
then \fIsrc\fR is expected to be in decimal form; otherwise,
|
||||
if the first such characters are
|
||||
.QW \fB0o\fR
|
||||
then \fIsrc\fR is expected to be in octal form; otherwise,
|
||||
if the first such characters are
|
||||
@@ -68,8 +65,8 @@ then \fIsrc\fR is expected to be in binary form; otherwise,
|
||||
if the first such character is
|
||||
.QW \fB0\fR
|
||||
then \fIsrc\fR
|
||||
is expected to be in octal form; otherwise, \fIsrc\fR
|
||||
is expected to be in decimal form.
|
||||
is expected to be in octal form; otherwise, \fIsrc\fR is
|
||||
expected to be in decimal form.
|
||||
.PP
|
||||
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
|
||||
number, which is: white space; a sign; a sequence of digits; a
|
||||
|
||||
+1
-1
@@ -97,7 +97,7 @@ are provided by the C language standard. The \fBTcl_WideInt\fR type is a
|
||||
typedef defined to be whatever signed integral type covers at least the
|
||||
64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending
|
||||
on the platform and the C compiler, the actual type might be
|
||||
\fBlong long int\fR, \fB__int64\fR, or something else.
|
||||
\fBlong int\fR, \fBlong long int\fR, \fBint64\fR, or something else.
|
||||
The \fBmp_int\fR type is a multiple-precision integer type defined
|
||||
by the LibTomMath multiple-precision integer library.
|
||||
.PP
|
||||
|
||||
+1
-1
@@ -101,7 +101,7 @@ the command. The \fIfreeProc\fR field will be initialized to zero,
|
||||
and \fIinterp->result\fR will point to an empty string. Commands that
|
||||
do not return any value can simply leave the fields alone.
|
||||
Furthermore, the empty string pointed to by \fIresult\fR is actually
|
||||
part of an array of approximately 200 characters.
|
||||
part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
|
||||
If a command wishes to return a short string, it can simply copy
|
||||
it to the area pointed to by \fIinterp->result\fR. Or, it can use
|
||||
the sprintf procedure to generate a short result string at the location
|
||||
|
||||
@@ -1,6 +1,5 @@
|
||||
.\"
|
||||
.\" Copyright (c) 2008 by Kevin B. Kenny.
|
||||
.\" Copyright (c) 2018 by Nathan Coulter.
|
||||
.\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
@@ -39,39 +38,43 @@ void
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_CmdDeleteProc *interp in
|
||||
.AP Tcl_Interp *interp in
|
||||
The relevant Interpreter.
|
||||
Interpreter in which to create or evaluate a command.
|
||||
.AP char *cmdName in
|
||||
Name of the command to create.
|
||||
Name of a new command to create.
|
||||
.AP Tcl_ObjCmdProc *proc in
|
||||
Called in order to evaluate a command. Is often just a small wrapper that uses
|
||||
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline. Behaves
|
||||
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
|
||||
(\fIq.v.\fR).
|
||||
Implementation of a command that will be called whenever \fIcmdName\fR
|
||||
is invoked as a command in the unoptimized way.
|
||||
.AP Tcl_ObjCmdProc *nreProc in
|
||||
Called instead of \fIproc\fR when a trampoline is already in use.
|
||||
Implementation of a command that will be called whenever \fIcmdName\fR
|
||||
is invoked and requested to conserve the C stack.
|
||||
.AP ClientData clientData in
|
||||
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
|
||||
and \fIobjProc\fR.
|
||||
Arbitrary one-word value that will be passed to \fIproc\fR, \fInreProc\fR,
|
||||
\fIdeleteProc\fR and \fIobjProc\fR.
|
||||
.AP Tcl_CmdDeleteProc *deleteProc in/out
|
||||
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
|
||||
command-specific cleanup. May be NULL.
|
||||
Procedure to call before \fIcmdName\fR is deleted from the interpreter.
|
||||
This procedure allows for command-specific cleanup. If \fIdeleteProc\fR
|
||||
is \fBNULL\fR, then no procedure is called before the command is deleted.
|
||||
.AP int objc in
|
||||
Number of items in \fIobjv\fR.
|
||||
Count of parameters provided to the implementation of a command.
|
||||
.AP Tcl_Obj **objv in
|
||||
Words in the command.
|
||||
Pointer to an array of Tcl values. Each value holds the value of a
|
||||
single word in the command to execute.
|
||||
.AP Tcl_Obj *objPtr in
|
||||
A script or expression to evaluate.
|
||||
Pointer to a Tcl_Obj whose value is a script or expression to execute.
|
||||
.AP int flags in
|
||||
As described for \fITcl_EvalObjv\fR.
|
||||
.PP
|
||||
ORed combination of flag bits that specify additional options.
|
||||
\fBTCL_EVAL_GLOBAL\fR is the only flag that is currently supported.
|
||||
.\" TODO: This is a lie. But kbk didn't grasp TCL_EVAL_INVOKE and
|
||||
.\" TCL_EVAL_NOERR well enough to document them.
|
||||
.AP Tcl_Command cmd in
|
||||
Token to use instead of one derived from the first word of \fIobjv\fR in order
|
||||
to evaluate a command.
|
||||
Token for a command that is to be used instead of the currently
|
||||
executing command.
|
||||
.AP Tcl_Obj *resultPtr out
|
||||
Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if
|
||||
the return code is TCL_OK.
|
||||
Pointer to an unshared Tcl_Obj where the result of expression
|
||||
evaluation is written.
|
||||
.AP Tcl_NRPostProc *postProcPtr in
|
||||
A function to push.
|
||||
Pointer to a function that will be invoked when the command currently
|
||||
executing in the interpreter designated by \fIinterp\fR completes.
|
||||
.AP ClientData data0 in
|
||||
.AP ClientData data1 in
|
||||
.AP ClientData data2 in
|
||||
@@ -81,51 +84,98 @@ to the function designated by \fIpostProcPtr\fR when it is invoked.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
These functions provide an interface to the function stack that an interpreter
|
||||
iterates through to evaluate commands. The routine behind a command is
|
||||
implemented by an initial function and any additional functions that the
|
||||
routine pushes onto the stack as it progresses. The interpreter itself pushes
|
||||
functions onto the stack to react to the end of a routine and to exercise other
|
||||
forms of control such as switching between in-progress stacks and the
|
||||
evaluation of other scripts at additional levels without adding frames to the C
|
||||
stack. To execute a routine, the initial function for the routine is called
|
||||
and then a small bit of code called a \fItrampoline\fR iteratively takes
|
||||
functions off the stack and calls them, using the value of the last call as the
|
||||
value of the routine.
|
||||
This series of C functions provides an interface whereby commands that
|
||||
are implemented in C can be evaluated, and invoke Tcl commands scripts
|
||||
and scripts, without consuming space on the C stack. The non-recursive
|
||||
evaluation is done by installing a \fItrampoline\fR, a small piece of
|
||||
code that invokes a command or script, and then executes a series of
|
||||
callbacks when the command or script returns.
|
||||
.PP
|
||||
\fBTcl_NRCallObjProc\fR calls \fInreProc\fR using a new trampoline.
|
||||
The \fBTcl_NRCreateCommand\fR function creates a Tcl command in the
|
||||
interpreter designated by \fIinterp\fR that is prepared to handle
|
||||
nonrecursive evaluation with a trampoline. The \fIcmdName\fR argument
|
||||
gives the name of the new command. If \fIcmdName\fR contains any
|
||||
namespace qualifiers, then the new command is added to the specified
|
||||
namespace; otherwise, it is added to the global namespace. \fIproc\fR
|
||||
gives the procedure that will be called when the interpreter wishes to
|
||||
evaluate the command in an unoptimized manner, and \fInreProc\fR is
|
||||
the procedure that will be called when the interpreter wishes to
|
||||
evaluate the command using a trampoline. \fIdeleteProc\fR is a
|
||||
function that will be called before the command is deleted from the
|
||||
interpreter. When any of the three functions is invoked, it is passed
|
||||
the \fIclientData\fR parameter.
|
||||
.PP
|
||||
\fBTcl_NRCreateCommand\fR, an alternative to \fBTcl_CreateObjCommand\fR,
|
||||
resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the
|
||||
current namespace, creates a command by that name, and returns a token for the
|
||||
command which may be used in subsequent calls to \fBTcl_GetCommandName\fR.
|
||||
Except for a few cases noted below any existing command by the same name is
|
||||
first deleted. If \fIinterp\fR is in the process of being deleted
|
||||
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
|
||||
command, and returns NULL.
|
||||
\fBTcl_NRCreateCommand\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 \fBTcl_NRCreateCommand\fR is called for an interpreter that is in
|
||||
the process of being deleted, then it does not create a new command,
|
||||
does not delete any existing command of the same name, and returns NULL.
|
||||
.PP
|
||||
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
|
||||
consumes no space on the C stack.
|
||||
The \fIproc\fR and \fInreProc\fR function are expected to conform to
|
||||
all the rules set forth for the \fIproc\fR argument to
|
||||
\fBTcl_CreateObjCommand\fR(3) (\fIq.v.\fR).
|
||||
.PP
|
||||
\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but
|
||||
consumes no space on the C stack.
|
||||
When a command that is written to cope with evaluation via trampoline
|
||||
is invoked without a trampoline on the stack, it will usually respond
|
||||
to the invocation by creating a trampoline and calling the
|
||||
trampoline-enabled implementation of the same command. This call is done by
|
||||
means of \fBTcl_NRCallObjProc\fR. In the call to
|
||||
\fBTcl_NRCallObjProc\fR, the \fIinterp\fR, \fIclientData\fR,
|
||||
\fIobjc\fR and \fIobjv\fR parameters should be the same ones that were
|
||||
passed to \fIproc\fR. The \fInreProc\fR parameter should designate the
|
||||
trampoline-enabled implementation of the command.
|
||||
.PP
|
||||
\fBTcl_NRCmdSwap\fR is like \fBTcl_NREvalObjv\fR, but uses \fIcmd\fR, a token
|
||||
previously returned by \fBTcl_CreateObjCommand\fR or
|
||||
\fBTcl_GetCommandFromObj\fR, instead of resolving the first word of \fIobjv\fR.
|
||||
. The name of this command must be the same as \fIobjv[0]\fR.
|
||||
\fBTcl_NREvalObj\fR arranges for the script contained in \fIobjPtr\fR
|
||||
to be evaluated in the interpreter designated by \fIinterp\fR after
|
||||
the current command (which must be trampoline-enabled) returns. It is
|
||||
the method by which a command may invoke a script without consuming
|
||||
space on the C stack. Similarly, \fBTcl_NREvalObjv\fR arranges to
|
||||
invoke a single Tcl command whose words have already been separated
|
||||
and substituted. The \fIobjc\fR and \fIobjv\fR parameters give the
|
||||
words of the command to be evaluated when execution reaches the
|
||||
trampoline.
|
||||
.PP
|
||||
\fBTcl_NRExprObj\fR pushes a function that evaluates \fIobjPtr\fR as an
|
||||
expression in the same manner as \fBTcl_ExprObj\fR but without consuming space
|
||||
on the C stack.
|
||||
\fBTcl_NRCmdSwap\fR allows for trampoline evaluation of a command whose
|
||||
resolution is already known. The \fIcmd\fR parameter gives a
|
||||
\fBTcl_Command\fR token (returned from \fBTcl_CreateObjCommand\fR or
|
||||
\fBTcl_GetCommandFromObj\fR) identifying the command to be invoked in
|
||||
the trampoline; this command must match the word in \fIobjv[0]\fR.
|
||||
The remaining arguments are as for \fBTcl_NREvalObjv\fR.
|
||||
.PP
|
||||
All of the functions return \fBTCL_OK\fR if the evaluation of the script,
|
||||
command, or expression has been scheduled successfully. Otherwise (for example
|
||||
if the command name cannot be resolved), they return \fBTCL_ERROR\fR and store
|
||||
a message as the interpreter's result.
|
||||
\fBTcl_NREvalObj\fR, \fBTcl_NREvalObjv\fR and \fBTcl_NRCmdSwap\fR
|
||||
all accept a \fIflags\fR parameter, which is an OR-ed-together set of
|
||||
bits to control evaluation. At the present time, the only supported flag
|
||||
available to callers is \fBTCL_EVAL_GLOBAL\fR.
|
||||
.\" TODO: Again, this is a lie. Do we want to explain TCL_EVAL_INVOKE
|
||||
.\" and TCL_EVAL_NOERR?
|
||||
If the \fBTCL_EVAL_GLOBAL\fR flag is set, the script or command is
|
||||
evaluated in the global namespace. If it is not set, it is evaluated
|
||||
in the current namespace.
|
||||
.PP
|
||||
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR. The signature for
|
||||
\fBTcl_NRPostProc\fR is:
|
||||
\fBTcl_NRExprObj\fR arranges for the expression contained in \fIobjPtr\fR
|
||||
to be evaluated in the interpreter designated by \fIinterp\fR after
|
||||
the current command (which must be trampoline-enabled) returns. It is
|
||||
the method by which a command may evaluate a Tcl expression without consuming
|
||||
space on the C stack. The argument \fIresultPtr\fR is a pointer to an
|
||||
unshared Tcl_Obj where the result of expression evaluation is to be written.
|
||||
If expression evaluation returns any code other than TCL_OK, the
|
||||
\fIresultPtr\fR value is left untouched.
|
||||
.PP
|
||||
All of the routines return \fBTCL_OK\fR if command or expression invocation
|
||||
has been scheduled successfully. If for any reason the scheduling cannot
|
||||
be completed (for example, if the interpreter is unable to find
|
||||
the requested command), they return \fBTCL_ERROR\fR with an
|
||||
appropriate message left in the interpreter's result.
|
||||
.PP
|
||||
\fBTcl_NRAddCallback\fR arranges to have a C function called when the
|
||||
current trampoline-enabled command in the Tcl interpreter designated
|
||||
by \fIinterp\fR returns. The \fIpostProcPtr\fR argument is a pointer
|
||||
to the callback function, which must have arguments and return value
|
||||
consistent with the \fBTcl_NRPostProc\fR data type:
|
||||
.PP
|
||||
.CS
|
||||
typedef int
|
||||
@@ -135,13 +185,25 @@ typedef int
|
||||
int \fIresult\fR);
|
||||
.CE
|
||||
.PP
|
||||
\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR.
|
||||
\fIresult\fR is the value returned by the previous function implementing part
|
||||
the routine.
|
||||
When the trampoline invokes the callback function, the \fIdata\fR
|
||||
parameter will point to an array containing the four one-word
|
||||
quantities that were passed to \fBTcl_NRAddCallback\fR in the
|
||||
\fIdata0\fR through \fIdata3\fR parameters. The Tcl interpreter will
|
||||
be designated by the \fIinterp\fR parameter, and the \fIresult\fR
|
||||
parameter will contain the result (\fBTCL_OK\fR, \fBTCL_ERROR\fR,
|
||||
\fBTCL_RETURN\fR, \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR) that was
|
||||
returned by the command evaluation. The callback function is expected,
|
||||
in turn, either to return a \fIresult\fR to control further evaluation.
|
||||
.PP
|
||||
Multiple \fBTcl_NRAddCallback\fR invocations may request multiple
|
||||
callbacks, which may be to the same or different callback
|
||||
functions. If multiple callbacks are requested, they are executed in
|
||||
last-in, first-out order, that is, the most recently requested
|
||||
callback is executed first.
|
||||
.SH EXAMPLE
|
||||
.PP
|
||||
The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C
|
||||
stack, to evalute a script:
|
||||
The usual pattern for Tcl commands that invoke other Tcl commands
|
||||
is something like:
|
||||
.PP
|
||||
.CS
|
||||
int
|
||||
@@ -166,17 +228,28 @@ int
|
||||
\fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
|
||||
.CE
|
||||
.PP
|
||||
To avoid consuming space on the C stack, \fITheCmdOldObjProc\fR is renamed to
|
||||
\fITheCmdNRObjProc\fR and the postprocessing step is split into a separate
|
||||
function, \fITheCmdPostProc\fR, which is pushed onto the function stack.
|
||||
\fITcl_EvalObjEx\fR is replaced with \fITcl_NREvalObj\fR, which uses a
|
||||
trampoline instead of consuming space on the C stack. A new version of
|
||||
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
|
||||
call \fITheCmdNRObjProc\fR:
|
||||
To enable a command like this one for trampoline-based evaluation,
|
||||
it must be split into three pieces:
|
||||
.IP \(bu
|
||||
A non-trampoline implementation, \fITheCmdNewObjProc\fR,
|
||||
which will simply create a trampoline
|
||||
and invoke the trampoline-based implementation.
|
||||
.IP \(bu
|
||||
A trampoline-enabled implementation, \fITheCmdNRObjProc\fR. This
|
||||
function will perform the initialization, request that the trampoline
|
||||
call the postprocessing routine after command evaluation, and finally,
|
||||
request that the trampoline call the inner command.
|
||||
.IP \(bu
|
||||
A postprocessing routine, \fITheCmdPostProc\fR. This function will
|
||||
perform the postprocessing formerly done after the return from the
|
||||
inner command in \fITheCmdObjProc\fR.
|
||||
.PP
|
||||
The non-trampoline implementation is simple and stylized, containing
|
||||
a single statement:
|
||||
.PP
|
||||
.CS
|
||||
int
|
||||
\fITheCmdOldObjProc\fR(
|
||||
\fITheCmdNewObjProc\fR(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
@@ -187,6 +260,9 @@ int
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
The trampoline-enabled implementation requests postprocessing,
|
||||
and returns to the trampoline requesting command evaluation.
|
||||
.PP
|
||||
.CS
|
||||
int
|
||||
\fITheCmdNRObjProc\fR
|
||||
@@ -208,6 +284,9 @@ int
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
The postprocessing procedure does whatever the original command did
|
||||
upon return from the inner evaluation.
|
||||
.PP
|
||||
.CS
|
||||
int
|
||||
\fITheCmdNRPostProc\fR(
|
||||
@@ -224,13 +303,26 @@ int
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
Any function comprising a routine can push other functions, making it possible
|
||||
implement looping and sequencing constructs using the function stack.
|
||||
If \fItheCommand\fR is a command that results in multiple commands or
|
||||
scripts being evaluated, its postprocessing routine may schedule
|
||||
additional postprocessing and then request another command evaluation
|
||||
by means of \fBTcl_NREvalObj\fR or one of the other evaluation
|
||||
routines. Looping and sequencing constructs may be implemented in this way.
|
||||
.PP
|
||||
Finally, to install a trampoline-enabled command in the interpreter,
|
||||
\fBTcl_NRCreateCommand\fR is used in place of
|
||||
\fBTcl_CreateObjCommand\fR. It accepts two command procedures instead
|
||||
of one. The first is for use when no trampoline is yet on the stack,
|
||||
and the second is for use when there is already a trampoline in place.
|
||||
.PP
|
||||
.CS
|
||||
\fBTcl_NRCreateCommand\fR(interp, "theCommand",
|
||||
\fITheCmdNewObjProc\fR, \fITheCmdNRObjProc\fR, clientData,
|
||||
TheCmdDeleteProc);
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
|
||||
.SH KEYWORDS
|
||||
stackless, nonrecursive, execute, command, global, value, result, script
|
||||
.SH COPYRIGHT
|
||||
Copyright (c) 2008 by Kevin B. Kenny.
|
||||
Copyright (c) 2018 by Nathan Coulter.
|
||||
Copyright (c) 2008 by Kevin B. Kenny
|
||||
|
||||
+1
-1
@@ -257,7 +257,7 @@ The \fBincr\fR command first gets an integer from \fIx\fR's value
|
||||
by calling \fBTcl_GetIntFromObj\fR.
|
||||
This procedure checks whether the value is already an integer value.
|
||||
Since it is not, it converts the value
|
||||
by setting the value's internal representation
|
||||
by setting the value's \fIinternalRep.longValue\fR member
|
||||
to the integer \fB123\fR
|
||||
and setting the value's \fItypePtr\fR
|
||||
to point to the integer Tcl_ObjType structure.
|
||||
|
||||
@@ -32,6 +32,8 @@ the command at global level instead of the current stack level.
|
||||
.PP
|
||||
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
|
||||
on the history list and then execute it using \fBTcl_EvalObjEx\fR
|
||||
(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set
|
||||
in \fIflags\fR).
|
||||
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
|
||||
as well as a result value containing additional information
|
||||
(a result value or error message)
|
||||
|
||||
+2
-2
@@ -54,9 +54,9 @@ is called, Tcl will take care of memory management.
|
||||
.PP
|
||||
The second triplet stores the snapshot of only the interpreter
|
||||
result (not its complete state) in memory allocated by the caller.
|
||||
These routines are passed a pointer to \fBTcl_SavedResult\fR
|
||||
These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
|
||||
that is used to store enough information to restore the interpreter result.
|
||||
\fBTcl_SavedResult\fR can be allocated on the stack of the calling
|
||||
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 \fB\-errorcode\fR or
|
||||
\fB\-errorinfo\fR return options, when an error is in progress).
|
||||
|
||||
+1
-1
@@ -33,7 +33,7 @@ int
|
||||
.SH ARGUMENTS
|
||||
.AS char *str in/out
|
||||
.AP int ch in
|
||||
The Unicode character to be converted.
|
||||
The Tcl_UniChar to be converted.
|
||||
.AP char *str in/out
|
||||
Pointer to UTF-8 string to be converted in place.
|
||||
.BE
|
||||
|
||||
@@ -48,16 +48,19 @@ int
|
||||
.SH ARGUMENTS
|
||||
.AS int ch
|
||||
.AP int ch in
|
||||
The Unicode character to be examined.
|
||||
The Tcl_UniChar to be examined.
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
All of the routines described examine Unicode characters and return a
|
||||
All of the routines described examine Tcl_UniChars and return a
|
||||
boolean value. A non-zero return value means that the character does
|
||||
belong to the character class associated with the called routine. The
|
||||
rest of this document just describes the character classes associated
|
||||
with the various routines.
|
||||
.PP
|
||||
Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
|
||||
fixed-size quantity.
|
||||
|
||||
.SH "CHARACTER CLASSES"
|
||||
.PP
|
||||
|
||||
@@ -77,7 +77,7 @@ int
|
||||
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most
|
||||
\fBTCL_UTF_MAX\fR bytes are stored in the buffer.
|
||||
.AP int ch in
|
||||
The Unicode character to be converted or examined.
|
||||
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
|
||||
|
||||
+1
-1
@@ -23,7 +23,7 @@ exception to occur.
|
||||
The exception causes the current script to be aborted
|
||||
out to the innermost containing loop command, which then
|
||||
continues with the next iteration of the loop.
|
||||
Continue exceptions are also handled in a few other situations, such
|
||||
Catch exceptions are also handled in a few other situations, such
|
||||
as the \fBcatch\fR command and the outermost scripts of procedure
|
||||
bodies.
|
||||
.SH EXAMPLE
|
||||
|
||||
+6
-16
@@ -14,7 +14,7 @@ oo::copy \- create copies of objects and classes
|
||||
.nf
|
||||
package require TclOO
|
||||
|
||||
\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? ?\fItargetNamespace\fR?
|
||||
\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR?
|
||||
.fi
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
@@ -22,21 +22,11 @@ package require TclOO
|
||||
The \fBoo::copy\fR command creates a copy of an object or class. It takes the
|
||||
name of the object or class to be copied, \fIsourceObject\fR, and optionally
|
||||
the name of the object or class to create, \fItargetObject\fR, which will be
|
||||
resolved relative to the current namespace if not an absolute qualified name
|
||||
and
|
||||
.VS TIP473
|
||||
\fItargetNamespace\fR which is the name of the namespace that will hold the
|
||||
internal state of the object (\fBmy\fR command, etc.); it \fImust not\fR
|
||||
refer to an existing namespace.
|
||||
If either \fItargetObject\fR or \fItargetNamespace\fR is omitted or is given
|
||||
as the empty string, a new name is chosen. Names, unless specified, are
|
||||
chosen with the same algorithm used by the \fBnew\fR method of
|
||||
\fBoo::class\fR.
|
||||
.VE TIP473
|
||||
The copied object will be of the same class as the source object, and will have
|
||||
all its per-object methods copied. If it is a class, it will also have all the
|
||||
class methods in the class copied, but it will not have any of its instances
|
||||
copied.
|
||||
resolved relative to the current namespace if not an absolute qualified name.
|
||||
If \fItargetObject\fR is omitted, a new name is chosen. The copied object will
|
||||
be of the same class as the source object, and will have all its per-object
|
||||
methods copied. If it is a class, it will also have all the class methods in
|
||||
the class copied, but it will not have any of its instances copied.
|
||||
.PP
|
||||
.VS
|
||||
After the \fItargetObject\fR has been created and all definitions of its
|
||||
|
||||
@@ -142,8 +142,6 @@ be afterwards.
|
||||
\fBself\fI subcommand arg ...\fR
|
||||
.TP
|
||||
\fBself\fI script\fR
|
||||
.TP
|
||||
\fBself\fR
|
||||
.
|
||||
This command is equivalent to calling \fBoo::objdefine\fR on the class being
|
||||
defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
|
||||
@@ -153,13 +151,6 @@ and
|
||||
.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
|
||||
operates identically to
|
||||
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP470
|
||||
If no arguments at all are used, this gives the name of the class currently
|
||||
being configured.
|
||||
.VE TIP470
|
||||
.RE
|
||||
.TP
|
||||
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.VS
|
||||
@@ -274,12 +265,6 @@ not previously refer to a method in that object. Does not affect the classes
|
||||
that the object is an instance of. Does not change the export status of the
|
||||
method; if it was exported before, it will be afterwards.
|
||||
.TP
|
||||
\fBself \fR
|
||||
.
|
||||
.VS TIP470
|
||||
This gives the name of the object currently being configured.
|
||||
.VE TIP470
|
||||
.TP
|
||||
\fBunexport\fI name \fR?\fIname ...\fR?
|
||||
.
|
||||
This arranges for each of the named methods, \fIname\fR, to be not exported
|
||||
|
||||
+1
-1
@@ -437,7 +437,7 @@ puts $foo
|
||||
# prints: \fIa b foo {a b} bar 2 baz 3\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
append(n), array(n), foreach(n), incr(n), list(n), lappend(n), lmap(n), set(n)
|
||||
append(n), array(n), foreach(n), mapeach(n), incr(n), list(n), lappend(n), set(n)
|
||||
.SH KEYWORDS
|
||||
dictionary, create, update, lookup, iterate, filter, map
|
||||
'\" Local Variables:
|
||||
|
||||
+2
-2
@@ -38,8 +38,8 @@ Performs one of several encoding related operations, depending on
|
||||
.
|
||||
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. This binary data
|
||||
is decoded as a string in the specified
|
||||
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
|
||||
|
||||
+1
-2
@@ -46,8 +46,7 @@ value is the form produced by the \fB%g\fR format specifier of Tcl's
|
||||
An expression consists of a combination of operands, operators, parentheses and
|
||||
commas, possibly with whitespace between any of these elements, which is
|
||||
ignored.
|
||||
An integer operand may be specified in decimal (the normal case, the optional
|
||||
first two characters are \fB0d\fR), binary
|
||||
An integer operand may be specified in decimal, binary
|
||||
(the first two characters are \fB0b\fR), octal
|
||||
(the first two characters are \fB0o\fR), or hexadecimal
|
||||
(the first two characters are \fB0x\fR) form. For
|
||||
|
||||
+8
-23
@@ -83,15 +83,12 @@ Specifies that the number should be padded on the left with
|
||||
zeroes instead of spaces.
|
||||
.TP 10
|
||||
\fB#\fR
|
||||
Requests an alternate output form. For \fBo\fR conversions,
|
||||
\fB0o\fR will be added to the beginning of the result unless
|
||||
it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR
|
||||
Requests an alternate output form. For \fBo\fR and \fBO\fR
|
||||
conversions it guarantees that the first digit is always \fB0\fR.
|
||||
For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
|
||||
will be added to the beginning of the result unless it is zero.
|
||||
For \fBb\fR conversions, \fB0b\fR
|
||||
will be added to the beginning of the result unless it is zero.
|
||||
For \fBd\fR conversions, \fB0d\fR there is no effect unless
|
||||
the \fB0\fR specifier is used as well: In that case, \fB0d\fR
|
||||
will be added to the beginning.
|
||||
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
|
||||
\fBg\fR, and \fBG\fR) it guarantees that the result always
|
||||
has a decimal point.
|
||||
@@ -133,7 +130,7 @@ it must be a numeric string.
|
||||
.SS "OPTIONAL SIZE MODIFIER"
|
||||
.PP
|
||||
The fifth part of a conversion specifier is a size modifier,
|
||||
which must be \fBll\fR, \fBh\fR, \fBl\fR, or \fBL\fR.
|
||||
which must be \fBll\fR, \fBh\fR, or \fBl\fR.
|
||||
If it is \fBll\fR it specifies that an integer value is taken
|
||||
without truncation for conversion to a formatted substring.
|
||||
If it is \fBh\fR it specifies that an integer value is
|
||||
@@ -141,9 +138,7 @@ truncated to a 16-bit range before converting. This option is rarely useful.
|
||||
If it is \fBl\fR it specifies that the integer value is
|
||||
truncated to the same range as that produced by the \fBwide()\fR
|
||||
function of the \fBexpr\fR command (at least a 64-bit range).
|
||||
If it is \fBL\fR it specifies that an integer or double value is taken
|
||||
without truncation for conversion to a formatted substring.
|
||||
If neither \fBh\fR nor \fBl\fR nor \fBL\fR are present, the integer value is
|
||||
If neither \fBh\fR nor \fBl\fR are present, the integer value is
|
||||
truncated to the same range as that produced by the \fBint()\fR
|
||||
function of the \fBexpr\fR command (at least a 32-bit range, but
|
||||
determined by the value of the \fBwordSize\fR element of the
|
||||
@@ -174,7 +169,7 @@ for \fBx\fR and
|
||||
for \fBX\fR).
|
||||
.TP 10
|
||||
\fBb\fR
|
||||
Convert integer to unsigned binary string, using digits 0 and 1.
|
||||
Convert integer to binary string, using digits 0 and 1.
|
||||
.TP 10
|
||||
\fBc\fR
|
||||
Convert integer to the Unicode character it represents.
|
||||
@@ -203,19 +198,8 @@ precision, then convert number as for \fB%e\fR or
|
||||
Otherwise convert as for \fB%f\fR.
|
||||
Trailing zeroes and a trailing decimal point are omitted.
|
||||
.TP 10
|
||||
\fBa\fR or \fBA\fR
|
||||
Convert double to hexadecimal notation in the form
|
||||
\fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is
|
||||
determined by the precision (default: 13).
|
||||
If the \fBA\fR form is used then the hex characters
|
||||
are printed in uppercase.
|
||||
.TP 10
|
||||
\fB%\fR
|
||||
No conversion: just insert \fB%\fR.
|
||||
.TP 10
|
||||
\fBp\fR
|
||||
Shorthand form for \fB0x%zx\fR, so it outputs the integer in
|
||||
hexadecimal form with \fB0x\fR prefix.
|
||||
.SH "DIFFERENCES FROM ANSI SPRINTF"
|
||||
.PP
|
||||
The behavior of the format command is the same as the
|
||||
@@ -224,12 +208,13 @@ differences:
|
||||
.IP [1]
|
||||
Tcl guarantees that it will be working with UNICODE characters.
|
||||
.IP [2]
|
||||
\fB%n\fR specifier is not supported.
|
||||
\fB%p\fR and \fB%n\fR specifiers are not supported.
|
||||
.IP [3]
|
||||
For \fB%c\fR conversions the argument must be an integer value,
|
||||
which will then be converted to the corresponding character value.
|
||||
.IP [4]
|
||||
The size modifiers are ignored when formatting floating-point values.
|
||||
The \fBll\fR modifier has no \fBsprintf\fR counterpart.
|
||||
The \fBb\fR specifier has no \fBsprintf\fR counterpart.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
|
||||
+1
-1
@@ -297,7 +297,7 @@ scripts are stored.
|
||||
This is actually the value of the \fBtcl_library\fR
|
||||
variable and may be changed by setting \fBtcl_library\fR.
|
||||
.TP
|
||||
\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
|
||||
\fBinfo loaded \fR?\fIinterp\fR? \fR?\fIpackage\fR?
|
||||
.
|
||||
Returns the filename loaded as part of \fIpackage\fR. If \fIpackage\fR
|
||||
is not specified, returns a list describing all of the packages
|
||||
|
||||
@@ -148,19 +148,6 @@ or \fB\-not\fR.
|
||||
These options are used to search lists of lists. They may be used
|
||||
with any other options.
|
||||
.TP
|
||||
\fB\-stride\0\fIstrideLength\fR
|
||||
.
|
||||
If this option is specified, the list is treated as consisting of
|
||||
groups of \fIstrideLength\fR elements and the groups are searched by
|
||||
either their first element or, if the \fB\-index\fR option is used,
|
||||
by the element within each group given by the first index passed to
|
||||
\fB\-index\fR (which is then ignored by \fB\-index\fR). The resulting
|
||||
index always points to the first element in a group.
|
||||
.PP
|
||||
The list length must be an integer multiple of \fIstrideLength\fR, which
|
||||
in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and
|
||||
indicates no grouping.
|
||||
.TP
|
||||
\fB\-index\fR\0\fIindexList\fR
|
||||
.
|
||||
This option is designed for use when searching within nested lists.
|
||||
@@ -221,13 +208,6 @@ It is also possible to search inside elements:
|
||||
\fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc*
|
||||
\fI\(-> {a abc} {b bcd}\fR
|
||||
.CE
|
||||
.PP
|
||||
The same thing for a flattened list:
|
||||
.PP
|
||||
.CS
|
||||
\fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc*
|
||||
\fI\(-> {a abc b bcd}\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
|
||||
lset(n), lsort(n), lrange(n), lreplace(n),
|
||||
|
||||
+27
-178
@@ -11,9 +11,9 @@
|
||||
.SH NAME
|
||||
msgcat \- Tcl message catalog
|
||||
.SH SYNOPSIS
|
||||
\fBpackage require Tcl 8.7\fR
|
||||
\fBpackage require Tcl 8.5\fR
|
||||
.sp
|
||||
\fBpackage require msgcat 1.7\fR
|
||||
\fBpackage require msgcat 1.6\fR
|
||||
.sp
|
||||
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
|
||||
.sp
|
||||
@@ -23,15 +23,9 @@ msgcat \- Tcl message catalog
|
||||
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
|
||||
.VE "TIP 412"
|
||||
.sp
|
||||
.VS "TIP 490"
|
||||
\fB::msgcat::mcpackagenamespaceget\fR
|
||||
.VE "TIP 490"
|
||||
.sp
|
||||
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
|
||||
.sp
|
||||
.VS "TIP 499"
|
||||
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
|
||||
.VE "TIP 499"
|
||||
\fB::msgcat::mcpreferences\fR
|
||||
.sp
|
||||
.VS "TIP 412"
|
||||
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
|
||||
@@ -56,10 +50,6 @@ msgcat \- Tcl message catalog
|
||||
.sp
|
||||
\fB::msgcat::mcforgetpackage\fR
|
||||
.VE "TIP 412"
|
||||
.sp
|
||||
.VS "TIP 499"
|
||||
\fB::msgcat::mcutil subcommand\fR ?\fIlocale\fR?
|
||||
.VS "TIP 499"
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
@@ -81,11 +71,6 @@ In \fBmsgcat\fR, there is a global locale initialized by the system locale of th
|
||||
Each package may decide to use the global locale or to use a package specific locale.
|
||||
.PP
|
||||
The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
|
||||
.PP
|
||||
.VS tip490
|
||||
Object oriented programming is supported by the use of a package namespace.
|
||||
.VE tip490
|
||||
.PP
|
||||
.SH COMMANDS
|
||||
.TP
|
||||
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
|
||||
@@ -110,17 +95,6 @@ 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.
|
||||
.RE
|
||||
.VS "TIP 490"
|
||||
.TP
|
||||
\fB::msgcat::mcn \fInamespace\fR \fIsrc-string\fR ?\fIarg arg ...\fR?
|
||||
.
|
||||
Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument.
|
||||
.PP
|
||||
.RS
|
||||
\fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller.
|
||||
An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below.
|
||||
.RE
|
||||
.PP
|
||||
.TP
|
||||
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
|
||||
.
|
||||
@@ -129,68 +103,28 @@ of the longest translated string. This is useful when designing
|
||||
localized GUIs, which may require that all buttons, for example, be a
|
||||
fixed width (which will be the width of the widest button).
|
||||
.TP
|
||||
.VS "TIP 412"
|
||||
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR
|
||||
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
|
||||
.
|
||||
.VS "TIP 412"
|
||||
Return true, if there is a translation for the given \fIsrc-string\fR.
|
||||
.PP
|
||||
.RS
|
||||
The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
|
||||
.PP
|
||||
It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
|
||||
.PP
|
||||
.RE
|
||||
.VE "TIP 412"
|
||||
.VS "TIP 490"
|
||||
An explicit package namespace may be specified by the option \fB-namespace\fR.
|
||||
The namespace of the caller is used if not explicitly specified.
|
||||
.RE
|
||||
.PP
|
||||
.VE "TIP 490"
|
||||
.VS "TIP 490"
|
||||
.TP
|
||||
\fB::msgcat::mcpackagenamespaceget\fR
|
||||
.
|
||||
Return the package namespace of the caller.
|
||||
This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR.
|
||||
.PP
|
||||
.RS
|
||||
Example usage is a tooltip package, which saves the caller package namespace to update the translation each time the tooltip is shown:
|
||||
.CS
|
||||
proc ::tooltip::tooltip {widget message} {
|
||||
...
|
||||
set messagenamespace [uplevel 1 {::msgcat::mcpackagenamespaceget}]
|
||||
...
|
||||
bind $widget [list ::tooltip::show $widget $messagenamespace $message]
|
||||
}
|
||||
|
||||
proc ::tooltip::show {widget messagenamespace message} {
|
||||
...
|
||||
set message [::msgcat::mcn $messagenamespace $message]
|
||||
...
|
||||
}
|
||||
.CE
|
||||
.RE
|
||||
.PP
|
||||
.VE "TIP 490"
|
||||
.TP
|
||||
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
|
||||
.
|
||||
If \fInewLocale\fR is omitted, the current locale is returned, otherwise the current locale
|
||||
is set to \fInewLocale\fR.
|
||||
.PP
|
||||
.RS
|
||||
If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set.
|
||||
For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR.
|
||||
.PP
|
||||
The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fR \fInewLocale\fR].
|
||||
.PP
|
||||
The current locale is always the first element of the list returned by \fBmcpreferences\fR.
|
||||
.PP
|
||||
msgcat stores and compares the locale in a
|
||||
This function sets the locale to \fInewLocale\fR. If \fInewLocale\fR
|
||||
is omitted, the current locale is returned, otherwise the current locale
|
||||
is set to \fInewLocale\fR. msgcat stores and compares the locale in a
|
||||
case-insensitive manner, and returns locales in lowercase.
|
||||
The initial locale is determined by the locale specified in
|
||||
the user's environment. See \fBLOCALE SPECIFICATION\fR
|
||||
below for a description of the locale string format.
|
||||
.RS
|
||||
.PP
|
||||
.VS "TIP 412"
|
||||
If the locale is set, the preference list of locales is evaluated.
|
||||
@@ -198,26 +132,16 @@ Locales in this list are loaded now, if not jet loaded.
|
||||
.VE "TIP 412"
|
||||
.RE
|
||||
.TP
|
||||
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
|
||||
\fB::msgcat::mcpreferences\fR
|
||||
.
|
||||
Without arguments, returns an ordered list of the locales preferred by
|
||||
the user.
|
||||
The list is ordered from most specific to least preference.
|
||||
.PP
|
||||
.VS "TIP 499"
|
||||
.RS
|
||||
A set of locale preferences may be given to set the list of locale preferences.
|
||||
The current locale is also set, which is the first element of the locale preferences list.
|
||||
.PP
|
||||
Locale preferences are loaded now, if not jet loaded.
|
||||
.PP
|
||||
As an example, the user may prefer French or English text. This may be configured by:
|
||||
.CS
|
||||
::msgcat::mcpreferences fr en {}
|
||||
.CE
|
||||
.RE
|
||||
.PP
|
||||
.VS "TIP 499"
|
||||
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. The list is derived from the current
|
||||
locale set in msgcat by \fB::msgcat::mclocale\fR, and
|
||||
cannot be set independently. For example, if the
|
||||
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
|
||||
returns \fB{en_us_funky en_us en {}}\fR.
|
||||
.TP
|
||||
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
|
||||
.
|
||||
@@ -308,22 +232,6 @@ Note that this routine is only called if the concerned package did not set a pac
|
||||
The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
|
||||
.VE "TIP 412"
|
||||
.PP
|
||||
.VS "TIP 499"
|
||||
.TP
|
||||
\fB::msgcat::mcutil getpreferences\fR \fIlocale\fR
|
||||
.
|
||||
Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR.
|
||||
An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french:
|
||||
.CS
|
||||
% concat [lrange [msgcat::mcutil getpreferences fr_CH] 0 end-1] [msgcat::mcutil getpreferences de_CH]
|
||||
fr_ch fr de_ch de {}
|
||||
.CE
|
||||
.TP
|
||||
\fB::msgcat::mcutil getsystemlocale\fR
|
||||
.
|
||||
The system locale is returned as described by the section \fBLOCALE SPECIFICATION\fR.
|
||||
.VE "TIP 499"
|
||||
.PP
|
||||
.SH "LOCALE SPECIFICATION"
|
||||
.PP
|
||||
The locale is specified to \fBmsgcat\fR by a locale string
|
||||
@@ -529,7 +437,7 @@ formatting substitution is done directly.
|
||||
# human-oriented versions by \fBmsgcat::mcset\fR
|
||||
.CE
|
||||
.VS "TIP 412"
|
||||
.SH "PACKAGE PRIVATE LOCALE"
|
||||
.SH Package private locale
|
||||
.PP
|
||||
A package using \fBmsgcat\fR may choose to use its own package private
|
||||
locale and its own set of loaded locales, independent to the global
|
||||
@@ -553,22 +461,10 @@ This command may cause the load of locales.
|
||||
.
|
||||
Return the package private locale or the global locale, if no package private locale is set.
|
||||
.TP
|
||||
\fB::msgcat::mcpackagelocale preferences\fR ?\fIlocale preference\fR? ...
|
||||
\fB::msgcat::mcpackagelocale preferences\fR
|
||||
.
|
||||
With no parameters, return the package private preferences or the global preferences,
|
||||
Return the package private preferences or the global preferences,
|
||||
if no package private locale is set.
|
||||
The package locale state (set or not) is not changed (in contrast to the command \fB::msgcat::mcpackagelocale set\fR).
|
||||
.PP
|
||||
.RS
|
||||
.VS "TIP 499"
|
||||
If a set of locale preferences is given, it is set as package locale preference list.
|
||||
The package locale is set to the first element of the preference list.
|
||||
A package locale is activated, if it was not set so far.
|
||||
.PP
|
||||
Locale preferences are loaded now for the package, if not jet loaded.
|
||||
.VE "TIP 499"
|
||||
.RE
|
||||
.PP
|
||||
.TP
|
||||
\fB::msgcat::mcpackagelocale loaded\fR
|
||||
.
|
||||
@@ -592,7 +488,7 @@ Returns true, if the given locale is loaded for the package.
|
||||
.
|
||||
Clear any loaded locales of the package not present in the package preferences.
|
||||
.PP
|
||||
.SH "CHANGING PACKAGE OPTIONS"
|
||||
.SH Changing package options
|
||||
.PP
|
||||
Each package using msgcat has a set of options within \fBmsgcat\fR.
|
||||
The package options are described in the next sectionPackage options.
|
||||
@@ -667,7 +563,7 @@ A generic unknown handler is used if set to the empty string. This consists in r
|
||||
See section \fBcallback invocation\fR below.
|
||||
The appended arguments are identical to \fB::msgcat::mcunknown\fR.
|
||||
.RE
|
||||
.SH "Callback invocation"
|
||||
.SS Callback invocation
|
||||
A package may decide to register one or multiple callbacks, as described above.
|
||||
.PP
|
||||
Callbacks are invoked, if:
|
||||
@@ -681,54 +577,7 @@ Callbacks are invoked, if:
|
||||
If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
|
||||
Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
|
||||
.PP
|
||||
.VS tip490
|
||||
.SH "OBJECT ORIENTED PROGRAMMING"
|
||||
\fBmsgcat\fR supports packages implemented by object oriented programming.
|
||||
Objects and classes should be defined within a package namespace.
|
||||
.PP
|
||||
There are 3 supported cases where package namespace sensitive commands of msgcat (\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, \fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) may be called:
|
||||
.PP
|
||||
.TP
|
||||
\fB1) In class definition script\fR
|
||||
.
|
||||
\fBmsgcat\fR command is called within a class definition script.
|
||||
.CS
|
||||
namespace eval ::N2 {
|
||||
mcload $dir/msgs
|
||||
oo::class create C1 {puts [mc Hi!]}
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
.TP
|
||||
\fB2) method defined in a class\fR
|
||||
.
|
||||
\fBmsgcat\fR command is called from a method in an object and the method is defined in a class.
|
||||
.CS
|
||||
namespace eval ::N3Class {
|
||||
mcload $dir/msgs
|
||||
oo::class create C1
|
||||
oo::define C1 method m1 {
|
||||
puts [mc Hi!]
|
||||
}
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
.TP
|
||||
\fB3) method defined in a classless object\fR
|
||||
.
|
||||
\fBmsgcat\fR command is called from a method of a classless object.
|
||||
.CS
|
||||
namespace eval ::N4 {
|
||||
mcload $dir/msgs
|
||||
oo::object create O1
|
||||
oo::objdefine O1 method m1 {} {
|
||||
puts [mc Hi!]
|
||||
}
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
.VE tip490
|
||||
.SH EXAMPLES
|
||||
.SS Examples
|
||||
Packages which display a GUI may update their widgets when the global locale changes.
|
||||
To register to a callback, use:
|
||||
.CS
|
||||
@@ -794,9 +643,9 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
|
||||
.PP
|
||||
The message catalog code was developed by Mark Harrison.
|
||||
.SH "SEE ALSO"
|
||||
format(n), scan(n), namespace(n), package(n), oo::class(n), oo::object
|
||||
format(n), scan(n), namespace(n), package(n)
|
||||
.SH KEYWORDS
|
||||
internationalization, i18n, localization, l10n, message, text, translation, class, object
|
||||
internationalization, i18n, localization, l10n, message, text, translation
|
||||
.\" Local Variables:
|
||||
.\" mode: nroff
|
||||
.\" End:
|
||||
|
||||
+3
-3
@@ -293,12 +293,12 @@ treatment is as if the enclosing delimiters were
|
||||
.QW \fB[.\fR \&
|
||||
and
|
||||
.QW \fB.]\fR .)
|
||||
For example, if \fBo\fR and \fB\[^o]\fR are the members of an
|
||||
For example, if \fBo\fR and \fB\*(qo\fR are the members of an
|
||||
equivalence class, then
|
||||
.QW \fB[[=o=]]\fR ,
|
||||
.QW \fB[[=\[^o]=]]\fR ,
|
||||
.QW \fB[[=\*(qo=]]\fR ,
|
||||
and
|
||||
.QW \fB[o\[^o]]\fR \&
|
||||
.QW \fB[o\*(qo]\fR \&
|
||||
are all synonymous. An equivalence class may not be an endpoint of a range.
|
||||
.RS
|
||||
.PP
|
||||
|
||||
@@ -68,33 +68,6 @@ and
|
||||
sequences are handled for each substitution using the information
|
||||
from the corresponding match.
|
||||
.TP
|
||||
\fB\-command\fR
|
||||
.VS 8.7
|
||||
Changes the handling of \fIsubSpec\fR so that it is not treated
|
||||
as a template for a substitution string and the substrings
|
||||
.QW &
|
||||
and
|
||||
.QW \e\fIn\fR
|
||||
no longer have special meaning. Instead \fIsubSpec\fR must be a
|
||||
command prefix, that is, a non-empty list. The substring of \fIstring\fR
|
||||
that matches \fIexp\fR, and then each substring that matches each
|
||||
capturing sub-RE within \fIexp\fR are appended as additional elements
|
||||
to that list. (The items appended to the list are much like what
|
||||
\fBregexp\fR \fB-inline\fR would return). The completed list is then
|
||||
evaluated as a Tcl command, and the result of that command is the
|
||||
substitution string. Any error or exception from command evaluation
|
||||
becomes an error or exception from the \fBregsub\fR command.
|
||||
.RS
|
||||
.PP
|
||||
If \fB\-all\fR is not also given, the command callback will be invoked at most
|
||||
once (exactly when the regular expression matches). If \fB\-all\fR is given,
|
||||
the command callback will be invoked for each matched location, in sequence.
|
||||
The exact location indices that matched are not made available to the script.
|
||||
.PP
|
||||
See \fBEXAMPLES\fR below for illustrative cases.
|
||||
.RE
|
||||
.VE 8.7
|
||||
.TP
|
||||
\fB\-expanded\fR
|
||||
.
|
||||
Enables use of the expanded regular expression syntax where
|
||||
@@ -210,53 +183,6 @@ set substitution {[format \e\e\e\eu%04x [scan "\e\e&" %c]]}
|
||||
set quoted [subst [string map {\en {\e\eu000a}} \e
|
||||
[\fBregsub\fR -all $RE $string $substitution]]]
|
||||
.CE
|
||||
.PP
|
||||
.VS 8.7
|
||||
The above operation can be done using \fBregsub \-command\fR instead, which is
|
||||
often faster. (A full pre-computed \fBstring map\fR would be faster still, but
|
||||
the cost of computing the map for a transformation as complex as this can be
|
||||
quite large.)
|
||||
.PP
|
||||
.CS
|
||||
# This RE is just a character class for everything "bad"
|
||||
set RE {[][{};#\e\e\e$\es\eu0080-\euffff]}
|
||||
|
||||
# This encodes what the RE described above matches
|
||||
proc encodeChar {ch} {
|
||||
# newline is handled specially since backslash-newline is a
|
||||
# special sequence.
|
||||
if {$ch eq "\en"} {
|
||||
return "\e\eu000a"
|
||||
}
|
||||
# No point in writing this as a one-liner
|
||||
scan $ch %c charNumber
|
||||
format "\e\eu%04x" $charNumber
|
||||
}
|
||||
|
||||
set quoted [\fBregsub\fR -all -command $RE $string encodeChar]
|
||||
.CE
|
||||
.PP
|
||||
Decoding a URL-encoded string using \fBregsub \-command\fR, a lambda term and
|
||||
the \fBapply\fR command.
|
||||
.PP
|
||||
.CS
|
||||
# Match one of the sequences in a URL-encoded string that needs
|
||||
# fixing, converting + to space and %XX to the right character
|
||||
# (e.g., %7e becomes ~)
|
||||
set RE {(\e+)|%([0-9A-Fa-f]{2})}
|
||||
|
||||
# Note that -command uses a command prefix, not a command name
|
||||
set decoded [\fBregsub\fR -all -command $RE $string {apply {{- p h} {
|
||||
# + is a special case; handle directly
|
||||
if {$p eq "+"} {
|
||||
return " "
|
||||
}
|
||||
# convert hex to a char
|
||||
scan $h %x charNumber
|
||||
format %c $charNumber
|
||||
}}}]
|
||||
.CE
|
||||
.VE 8.7
|
||||
.SH "SEE ALSO"
|
||||
regexp(n), re_syntax(n), subst(n), string(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+5
-3
@@ -115,7 +115,9 @@ Any Unicode control character.
|
||||
Any Unicode digit character. Note that this includes characters
|
||||
outside of the [0\-9] range.
|
||||
.IP \fBdouble\fR 12
|
||||
Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
|
||||
Any of the valid forms for a double in Tcl, with optional surrounding
|
||||
whitespace. In case of under/overflow in the value, 0 is returned and
|
||||
the \fIvarname\fR will contain \-1.
|
||||
.IP \fBentier\fR 12
|
||||
.VS 8.6
|
||||
Any of the valid string formats for an integer value of arbitrary size
|
||||
@@ -129,7 +131,7 @@ false.
|
||||
Any Unicode printing character, except space.
|
||||
.IP \fBinteger\fR 12
|
||||
Any of the valid string formats for a 32-bit integer value in Tcl,
|
||||
with optional surrounding whitespace. In case of overflow in
|
||||
with optional surrounding whitespace. In case of under/overflow in
|
||||
the value, 0 is returned and the \fIvarname\fR will contain \-1.
|
||||
.IP \fBlist\fR 12
|
||||
Any proper list structure, with optional surrounding whitespace. In
|
||||
@@ -154,7 +156,7 @@ true.
|
||||
Any upper case alphabet character in the Unicode character set.
|
||||
.IP \fBwideinteger\fR 12
|
||||
Any of the valid forms for a wide integer in Tcl, with optional
|
||||
surrounding whitespace. In case of overflow in the value, 0 is
|
||||
surrounding whitespace. In case of under/overflow in the value, 0 is
|
||||
returned and the \fIvarname\fR will contain \-1.
|
||||
.IP \fBwordchar\fR 12
|
||||
Any Unicode word character. That is any alphanumeric character, and
|
||||
|
||||
+202
-209
@@ -140,73 +140,73 @@ static const crange alphaRangeTable[] = {
|
||||
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x561, 0x587},
|
||||
{0x5d0, 0x5ea}, {0x5f0, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
|
||||
{0x6fa, 0x6fc}, {0x712, 0x72f}, {0x74d, 0x7a5}, {0x7ca, 0x7ea},
|
||||
{0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86a}, {0x8a0, 0x8b4},
|
||||
{0x8b6, 0x8bd}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
|
||||
{0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
|
||||
{0x9df, 0x9e1}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
|
||||
{0xa59, 0xa5c}, {0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91},
|
||||
{0xa93, 0xaa8}, {0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c},
|
||||
{0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61},
|
||||
{0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa},
|
||||
{0xbae, 0xbb9}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
|
||||
{0xc2a, 0xc39}, {0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
|
||||
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c},
|
||||
{0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61},
|
||||
{0xd7a, 0xd7f}, {0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb},
|
||||
{0xdc0, 0xdc6}, {0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97},
|
||||
{0xe99, 0xe9f}, {0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4},
|
||||
{0xedc, 0xedf}, {0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c},
|
||||
{0x1000, 0x102a}, {0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070},
|
||||
{0x1075, 0x1081}, {0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248},
|
||||
{0x124a, 0x124d}, {0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288},
|
||||
{0x128a, 0x128d}, {0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be},
|
||||
{0x12c2, 0x12c5}, {0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315},
|
||||
{0x1318, 0x135a}, {0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
|
||||
{0x1401, 0x166c}, {0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea},
|
||||
{0x16f1, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731},
|
||||
{0x1740, 0x1751}, {0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3},
|
||||
{0x1820, 0x1877}, {0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5},
|
||||
{0x1900, 0x191e}, {0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab},
|
||||
{0x19b0, 0x19c9}, {0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33},
|
||||
{0x1b45, 0x1b4b}, {0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23},
|
||||
{0x1c4d, 0x1c4f}, {0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec},
|
||||
{0x1cee, 0x1cf1}, {0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d},
|
||||
{0x1f20, 0x1f45}, {0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d},
|
||||
{0x1f80, 0x1fb4}, {0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc},
|
||||
{0x1fd0, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4},
|
||||
{0x1ff6, 0x1ffc}, {0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d},
|
||||
{0x212a, 0x212d}, {0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149},
|
||||
{0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee},
|
||||
{0x2d00, 0x2d25}, {0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6},
|
||||
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035},
|
||||
{0x3041, 0x3096}, {0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff},
|
||||
{0x3105, 0x312e}, {0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff},
|
||||
{0x3400, 0x4db5}, {0x4e00, 0x9fea}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd},
|
||||
{0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d},
|
||||
{0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae},
|
||||
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a},
|
||||
{0xa80c, 0xa822}, {0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7},
|
||||
{0xa90a, 0xa925}, {0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2},
|
||||
{0xa9e0, 0xa9e4}, {0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28},
|
||||
{0xaa40, 0xaa42}, {0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf},
|
||||
{0xaab9, 0xaabd}, {0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4},
|
||||
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
|
||||
{0xab28, 0xab2e}, {0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2},
|
||||
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e},
|
||||
{0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e},
|
||||
{0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e},
|
||||
{0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e},
|
||||
{0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d},
|
||||
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28},
|
||||
{0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d},
|
||||
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74},
|
||||
{0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe},
|
||||
{0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
|
||||
{0x800, 0x815}, {0x840, 0x858}, {0x8a0, 0x8b4}, {0x8b6, 0x8bd},
|
||||
{0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980}, {0x985, 0x98c},
|
||||
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9df, 0x9e1},
|
||||
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa59, 0xa5c},
|
||||
{0xa72, 0xa74}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
|
||||
{0xaaa, 0xab0}, {0xab5, 0xab9}, {0xb05, 0xb0c}, {0xb13, 0xb28},
|
||||
{0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb5f, 0xb61}, {0xb85, 0xb8a},
|
||||
{0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
|
||||
{0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39},
|
||||
{0xc58, 0xc5a}, {0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8},
|
||||
{0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xd05, 0xd0c}, {0xd0e, 0xd10},
|
||||
{0xd12, 0xd3a}, {0xd54, 0xd56}, {0xd5f, 0xd61}, {0xd7a, 0xd7f},
|
||||
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
|
||||
{0xe01, 0xe30}, {0xe40, 0xe46}, {0xe94, 0xe97}, {0xe99, 0xe9f},
|
||||
{0xea1, 0xea3}, {0xead, 0xeb0}, {0xec0, 0xec4}, {0xedc, 0xedf},
|
||||
{0xf40, 0xf47}, {0xf49, 0xf6c}, {0xf88, 0xf8c}, {0x1000, 0x102a},
|
||||
{0x1050, 0x1055}, {0x105a, 0x105d}, {0x106e, 0x1070}, {0x1075, 0x1081},
|
||||
{0x10a0, 0x10c5}, {0x10d0, 0x10fa}, {0x10fc, 0x1248}, {0x124a, 0x124d},
|
||||
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
|
||||
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
|
||||
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
|
||||
{0x1380, 0x138f}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1401, 0x166c},
|
||||
{0x166f, 0x167f}, {0x1681, 0x169a}, {0x16a0, 0x16ea}, {0x16f1, 0x16f8},
|
||||
{0x1700, 0x170c}, {0x170e, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
|
||||
{0x1760, 0x176c}, {0x176e, 0x1770}, {0x1780, 0x17b3}, {0x1820, 0x1877},
|
||||
{0x1880, 0x1884}, {0x1887, 0x18a8}, {0x18b0, 0x18f5}, {0x1900, 0x191e},
|
||||
{0x1950, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
|
||||
{0x1a00, 0x1a16}, {0x1a20, 0x1a54}, {0x1b05, 0x1b33}, {0x1b45, 0x1b4b},
|
||||
{0x1b83, 0x1ba0}, {0x1bba, 0x1be5}, {0x1c00, 0x1c23}, {0x1c4d, 0x1c4f},
|
||||
{0x1c5a, 0x1c7d}, {0x1c80, 0x1c88}, {0x1ce9, 0x1cec}, {0x1cee, 0x1cf1},
|
||||
{0x1d00, 0x1dbf}, {0x1e00, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
|
||||
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
|
||||
{0x1fb6, 0x1fbc}, {0x1fc2, 0x1fc4}, {0x1fc6, 0x1fcc}, {0x1fd0, 0x1fd3},
|
||||
{0x1fd6, 0x1fdb}, {0x1fe0, 0x1fec}, {0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffc},
|
||||
{0x2090, 0x209c}, {0x210a, 0x2113}, {0x2119, 0x211d}, {0x212a, 0x212d},
|
||||
{0x212f, 0x2139}, {0x213c, 0x213f}, {0x2145, 0x2149}, {0x2c00, 0x2c2e},
|
||||
{0x2c30, 0x2c5e}, {0x2c60, 0x2ce4}, {0x2ceb, 0x2cee}, {0x2d00, 0x2d25},
|
||||
{0x2d30, 0x2d67}, {0x2d80, 0x2d96}, {0x2da0, 0x2da6}, {0x2da8, 0x2dae},
|
||||
{0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6}, {0x2dc8, 0x2dce},
|
||||
{0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x3031, 0x3035}, {0x3041, 0x3096},
|
||||
{0x309d, 0x309f}, {0x30a1, 0x30fa}, {0x30fc, 0x30ff}, {0x3105, 0x312d},
|
||||
{0x3131, 0x318e}, {0x31a0, 0x31ba}, {0x31f0, 0x31ff}, {0x3400, 0x4db5},
|
||||
{0x4e00, 0x9fd5}, {0xa000, 0xa48c}, {0xa4d0, 0xa4fd}, {0xa500, 0xa60c},
|
||||
{0xa610, 0xa61f}, {0xa640, 0xa66e}, {0xa67f, 0xa69d}, {0xa6a0, 0xa6e5},
|
||||
{0xa717, 0xa71f}, {0xa722, 0xa788}, {0xa78b, 0xa7ae}, {0xa7b0, 0xa7b7},
|
||||
{0xa7f7, 0xa801}, {0xa803, 0xa805}, {0xa807, 0xa80a}, {0xa80c, 0xa822},
|
||||
{0xa840, 0xa873}, {0xa882, 0xa8b3}, {0xa8f2, 0xa8f7}, {0xa90a, 0xa925},
|
||||
{0xa930, 0xa946}, {0xa960, 0xa97c}, {0xa984, 0xa9b2}, {0xa9e0, 0xa9e4},
|
||||
{0xa9e6, 0xa9ef}, {0xa9fa, 0xa9fe}, {0xaa00, 0xaa28}, {0xaa40, 0xaa42},
|
||||
{0xaa44, 0xaa4b}, {0xaa60, 0xaa76}, {0xaa7e, 0xaaaf}, {0xaab9, 0xaabd},
|
||||
{0xaadb, 0xaadd}, {0xaae0, 0xaaea}, {0xaaf2, 0xaaf4}, {0xab01, 0xab06},
|
||||
{0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26}, {0xab28, 0xab2e},
|
||||
{0xab30, 0xab5a}, {0xab5c, 0xab65}, {0xab70, 0xabe2}, {0xac00, 0xd7a3},
|
||||
{0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xdc00, 0xdc3e}, {0xdc40, 0xdc7e},
|
||||
{0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe}, {0xdd00, 0xdd3e}, {0xdd40, 0xdd7e},
|
||||
{0xdd80, 0xddbe}, {0xddc0, 0xddfe}, {0xde00, 0xde3e}, {0xde40, 0xde7e},
|
||||
{0xde80, 0xdebe}, {0xdec0, 0xdefe}, {0xdf00, 0xdf3e}, {0xdf40, 0xdf7e},
|
||||
{0xdf80, 0xdfbe}, {0xdfc0, 0xdffe}, {0xf900, 0xfa6d}, {0xfa70, 0xfad9},
|
||||
{0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1f, 0xfb28}, {0xfb2a, 0xfb36},
|
||||
{0xfb38, 0xfb3c}, {0xfb46, 0xfbb1}, {0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f},
|
||||
{0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc},
|
||||
{0xff21, 0xff3a}, {0xff41, 0xff5a}, {0xff66, 0xffbe}, {0xffc2, 0xffc7},
|
||||
{0xffca, 0xffcf}, {0xffd2, 0xffd7}, {0xffda, 0xffdc}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10280, 0x1029c}, {0x102a0, 0x102d0},
|
||||
{0x10300, 0x1031f}, {0x1032d, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
|
||||
{0x10300, 0x1031f}, {0x10330, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
|
||||
{0x10380, 0x1039d}, {0x103a0, 0x103c3}, {0x103c8, 0x103cf}, {0x10400, 0x1049d},
|
||||
{0x104b0, 0x104d3}, {0x104d8, 0x104fb}, {0x10500, 0x10527}, {0x10530, 0x10563},
|
||||
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
|
||||
@@ -222,26 +222,24 @@ static const crange alphaRangeTable[] = {
|
||||
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
|
||||
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
|
||||
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
|
||||
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a83},
|
||||
{0x11a86, 0x11a89}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c2e},
|
||||
{0x11c72, 0x11c8f}, {0x11d00, 0x11d06}, {0x11d0b, 0x11d30}, {0x12000, 0x12399},
|
||||
{0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38},
|
||||
{0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43},
|
||||
{0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f},
|
||||
{0x17000, 0x187ec}, {0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb},
|
||||
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
|
||||
{0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9},
|
||||
{0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
{0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
|
||||
{0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0}, {0x1d6c2, 0x1d6da},
|
||||
{0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734}, {0x1d736, 0x1d74e},
|
||||
{0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8}, {0x1d7aa, 0x1d7c2},
|
||||
{0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943}, {0x1ee00, 0x1ee03},
|
||||
{0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f},
|
||||
{0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c},
|
||||
{0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9},
|
||||
{0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
|
||||
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}
|
||||
{0x11700, 0x11719}, {0x118a0, 0x118df}, {0x11ac0, 0x11af8}, {0x11c00, 0x11c08},
|
||||
{0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x12000, 0x12399}, {0x12480, 0x12543},
|
||||
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
|
||||
{0x16ad0, 0x16aed}, {0x16b00, 0x16b2f}, {0x16b40, 0x16b43}, {0x16b63, 0x16b77},
|
||||
{0x16b7d, 0x16b8f}, {0x16f00, 0x16f44}, {0x16f93, 0x16f9f}, {0x17000, 0x187ec},
|
||||
{0x18800, 0x18af2}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88},
|
||||
{0x1bc90, 0x1bc99}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
|
||||
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d6c0},
|
||||
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6fa}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d734},
|
||||
{0x1d736, 0x1d74e}, {0x1d750, 0x1d76e}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d7a8},
|
||||
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7cb}, {0x1e800, 0x1e8c4}, {0x1e900, 0x1e943},
|
||||
{0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37},
|
||||
{0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77},
|
||||
{0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3},
|
||||
{0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
|
||||
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -252,29 +250,28 @@ static const chr alphaCharTable[] = {
|
||||
0x38c, 0x559, 0x66e, 0x66f, 0x6d5, 0x6e5, 0x6e6, 0x6ee, 0x6ef,
|
||||
0x6ff, 0x710, 0x7b1, 0x7f4, 0x7f5, 0x7fa, 0x81a, 0x824, 0x828,
|
||||
0x93d, 0x950, 0x98f, 0x990, 0x9b2, 0x9bd, 0x9ce, 0x9dc, 0x9dd,
|
||||
0x9f0, 0x9f1, 0x9fc, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
|
||||
0xa38, 0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1,
|
||||
0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71,
|
||||
0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0,
|
||||
0xc3d, 0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1,
|
||||
0xcf2, 0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84,
|
||||
0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2,
|
||||
0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e,
|
||||
0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae,
|
||||
0x1baf, 0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f,
|
||||
0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184,
|
||||
0x2cf2, 0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b,
|
||||
0x303c, 0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5,
|
||||
0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
|
||||
0x9f0, 0x9f1, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36, 0xa38,
|
||||
0xa39, 0xa5e, 0xab2, 0xab3, 0xabd, 0xad0, 0xae0, 0xae1, 0xaf9,
|
||||
0xb0f, 0xb10, 0xb32, 0xb33, 0xb3d, 0xb5c, 0xb5d, 0xb71, 0xb83,
|
||||
0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f, 0xba3, 0xba4, 0xbd0, 0xc3d,
|
||||
0xc60, 0xc61, 0xc80, 0xcbd, 0xcde, 0xce0, 0xce1, 0xcf1, 0xcf2,
|
||||
0xd3d, 0xd4e, 0xdbd, 0xe32, 0xe33, 0xe81, 0xe82, 0xe84, 0xe87,
|
||||
0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab, 0xeb2, 0xeb3,
|
||||
0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065, 0x1066, 0x108e, 0x10c7,
|
||||
0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa, 0x1aa7, 0x1bae, 0x1baf,
|
||||
0x1cf5, 0x1cf6, 0x1f59, 0x1f5b, 0x1f5d, 0x1fbe, 0x2071, 0x207f, 0x2102,
|
||||
0x2107, 0x2115, 0x2124, 0x2126, 0x2128, 0x214e, 0x2183, 0x2184, 0x2cf2,
|
||||
0x2cf3, 0x2d27, 0x2d2d, 0x2d6f, 0x2e2f, 0x3005, 0x3006, 0x303b, 0x303c,
|
||||
0xa62a, 0xa62b, 0xa8fb, 0xa8fd, 0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6,
|
||||
0xaac0, 0xaac2, 0xfb1d, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1003c, 0x1003d, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4, 0x108f5, 0x109be,
|
||||
0x109bf, 0x10a00, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f, 0x11310, 0x11332,
|
||||
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11a00,
|
||||
0x11a3a, 0x11a50, 0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x16f50, 0x16fe0, 0x16fe1,
|
||||
0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22,
|
||||
0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51,
|
||||
0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62,
|
||||
0x1ee64, 0x1ee7e
|
||||
0x11333, 0x1133d, 0x11350, 0x114c4, 0x114c5, 0x114c7, 0x11644, 0x118ff, 0x11c40,
|
||||
0x16f50, 0x16fe0, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6,
|
||||
0x1d4bb, 0x1d546, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
|
||||
0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
|
||||
0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -324,8 +321,8 @@ static const crange digitRangeTable[] = {
|
||||
,{0x104a0, 0x104a9}, {0x11066, 0x1106f}, {0x110f0, 0x110f9}, {0x11136, 0x1113f},
|
||||
{0x111d0, 0x111d9}, {0x112f0, 0x112f9}, {0x11450, 0x11459}, {0x114d0, 0x114d9},
|
||||
{0x11650, 0x11659}, {0x116c0, 0x116c9}, {0x11730, 0x11739}, {0x118e0, 0x118e9},
|
||||
{0x11c50, 0x11c59}, {0x11d50, 0x11d59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59},
|
||||
{0x1d7ce, 0x1d7ff}, {0x1e950, 0x1e959}
|
||||
{0x11c50, 0x11c59}, {0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff},
|
||||
{0x1e950, 0x1e959}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -348,7 +345,7 @@ static const crange punctRangeTable[] = {
|
||||
{0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7},
|
||||
{0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e},
|
||||
{0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e44},
|
||||
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
|
||||
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
|
||||
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
|
||||
@@ -359,8 +356,7 @@ static const crange punctRangeTable[] = {
|
||||
{0x10b99, 0x10b9c}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143},
|
||||
{0x111c5, 0x111c9}, {0x111dd, 0x111df}, {0x11238, 0x1123d}, {0x1144b, 0x1144f},
|
||||
{0x115c1, 0x115d7}, {0x11641, 0x11643}, {0x11660, 0x1166c}, {0x1173c, 0x1173e},
|
||||
{0x11a3f, 0x11a46}, {0x11a9a, 0x11a9c}, {0x11a9e, 0x11aa2}, {0x11c41, 0x11c45},
|
||||
{0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
|
||||
{0x11c41, 0x11c45}, {0x12470, 0x12474}, {0x16b37, 0x16b3b}, {0x1da87, 0x1da8b}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -371,14 +367,14 @@ static const chr punctCharTable[] = {
|
||||
0xab, 0xb6, 0xb7, 0xbb, 0xbf, 0x37e, 0x387, 0x589, 0x58a,
|
||||
0x5be, 0x5c0, 0x5c3, 0x5c6, 0x5f3, 0x5f4, 0x609, 0x60a, 0x60c,
|
||||
0x60d, 0x61b, 0x61e, 0x61f, 0x6d4, 0x85e, 0x964, 0x965, 0x970,
|
||||
0x9fd, 0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9,
|
||||
0xfda, 0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736,
|
||||
0x1944, 0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e,
|
||||
0x208d, 0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe,
|
||||
0x2cff, 0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673,
|
||||
0xa67e, 0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df,
|
||||
0xaade, 0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68,
|
||||
0xfe6a, 0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
|
||||
0xaf0, 0xdf4, 0xe4f, 0xe5a, 0xe5b, 0xf14, 0xf85, 0xfd9, 0xfda,
|
||||
0x10fb, 0x1400, 0x166d, 0x166e, 0x169b, 0x169c, 0x1735, 0x1736, 0x1944,
|
||||
0x1945, 0x1a1e, 0x1a1f, 0x1c7e, 0x1c7f, 0x1cd3, 0x207d, 0x207e, 0x208d,
|
||||
0x208e, 0x2329, 0x232a, 0x27c5, 0x27c6, 0x29fc, 0x29fd, 0x2cfe, 0x2cff,
|
||||
0x2d70, 0x3030, 0x303d, 0x30a0, 0x30fb, 0xa4fe, 0xa4ff, 0xa673, 0xa67e,
|
||||
0xa8ce, 0xa8cf, 0xa8fc, 0xa92e, 0xa92f, 0xa95f, 0xa9de, 0xa9df, 0xaade,
|
||||
0xaadf, 0xaaf0, 0xaaf1, 0xabeb, 0xfd3e, 0xfd3f, 0xfe63, 0xfe68, 0xfe6a,
|
||||
0xfe6b, 0xff1a, 0xff1b, 0xff1f, 0xff20, 0xff3f, 0xff5b, 0xff5d
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
|
||||
@@ -619,63 +615,63 @@ static const crange graphRangeTable[] = {
|
||||
{0x559, 0x55f}, {0x561, 0x587}, {0x58d, 0x58f}, {0x591, 0x5c7},
|
||||
{0x5d0, 0x5ea}, {0x5f0, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc},
|
||||
{0x6de, 0x70d}, {0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa},
|
||||
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a},
|
||||
{0x8a0, 0x8b4}, {0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983},
|
||||
{0x985, 0x98c}, {0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9},
|
||||
{0x9bc, 0x9c4}, {0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fd},
|
||||
{0xa01, 0xa03}, {0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30},
|
||||
{0xa3e, 0xa42}, {0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75},
|
||||
{0xa81, 0xa83}, {0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8},
|
||||
{0xaaa, 0xab0}, {0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9},
|
||||
{0xacb, 0xacd}, {0xae0, 0xae3}, {0xae6, 0xaf1}, {0xaf9, 0xaff},
|
||||
{0xb01, 0xb03}, {0xb05, 0xb0c}, {0xb13, 0xb28}, {0xb2a, 0xb30},
|
||||
{0xb35, 0xb39}, {0xb3c, 0xb44}, {0xb4b, 0xb4d}, {0xb5f, 0xb63},
|
||||
{0xb66, 0xb77}, {0xb85, 0xb8a}, {0xb8e, 0xb90}, {0xb92, 0xb95},
|
||||
{0xba8, 0xbaa}, {0xbae, 0xbb9}, {0xbbe, 0xbc2}, {0xbc6, 0xbc8},
|
||||
{0xbca, 0xbcd}, {0xbe6, 0xbfa}, {0xc00, 0xc03}, {0xc05, 0xc0c},
|
||||
{0xc0e, 0xc10}, {0xc12, 0xc28}, {0xc2a, 0xc39}, {0xc3d, 0xc44},
|
||||
{0xc46, 0xc48}, {0xc4a, 0xc4d}, {0xc58, 0xc5a}, {0xc60, 0xc63},
|
||||
{0xc66, 0xc6f}, {0xc78, 0xc83}, {0xc85, 0xc8c}, {0xc8e, 0xc90},
|
||||
{0xc92, 0xca8}, {0xcaa, 0xcb3}, {0xcb5, 0xcb9}, {0xcbc, 0xcc4},
|
||||
{0xcc6, 0xcc8}, {0xcca, 0xccd}, {0xce0, 0xce3}, {0xce6, 0xcef},
|
||||
{0xd00, 0xd03}, {0xd05, 0xd0c}, {0xd0e, 0xd10}, {0xd12, 0xd44},
|
||||
{0xd46, 0xd48}, {0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f},
|
||||
{0xd85, 0xd96}, {0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6},
|
||||
{0xdcf, 0xdd4}, {0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4},
|
||||
{0xe01, 0xe3a}, {0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f},
|
||||
{0xea1, 0xea3}, {0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4},
|
||||
{0xec8, 0xecd}, {0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47},
|
||||
{0xf49, 0xf6c}, {0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc},
|
||||
{0xfce, 0xfda}, {0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d},
|
||||
{0x1250, 0x1256}, {0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d},
|
||||
{0x1290, 0x12b0}, {0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5},
|
||||
{0x12c8, 0x12d6}, {0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a},
|
||||
{0x135d, 0x137c}, {0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd},
|
||||
{0x1400, 0x167f}, {0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c},
|
||||
{0x170e, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c},
|
||||
{0x176e, 0x1770}, {0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9},
|
||||
{0x1800, 0x180d}, {0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa},
|
||||
{0x18b0, 0x18f5}, {0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b},
|
||||
{0x1944, 0x196d}, {0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9},
|
||||
{0x19d0, 0x19da}, {0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c},
|
||||
{0x1a7f, 0x1a89}, {0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe},
|
||||
{0x1b00, 0x1b4b}, {0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37},
|
||||
{0x1c3b, 0x1c49}, {0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf9},
|
||||
{0x1d00, 0x1df9}, {0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45},
|
||||
{0x1f48, 0x1f4d}, {0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4},
|
||||
{0x1fb6, 0x1fc4}, {0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef},
|
||||
{0x1ff2, 0x1ff4}, {0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e},
|
||||
{0x2074, 0x208e}, {0x2090, 0x209c}, {0x20a0, 0x20bf}, {0x20d0, 0x20f0},
|
||||
{0x2100, 0x218b}, {0x2190, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
|
||||
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd2},
|
||||
{0x800, 0x82d}, {0x830, 0x83e}, {0x840, 0x85b}, {0x8a0, 0x8b4},
|
||||
{0x8b6, 0x8bd}, {0x8d4, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
|
||||
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
|
||||
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fb}, {0xa01, 0xa03},
|
||||
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
|
||||
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa75}, {0xa81, 0xa83},
|
||||
{0xa85, 0xa8d}, {0xa8f, 0xa91}, {0xa93, 0xaa8}, {0xaaa, 0xab0},
|
||||
{0xab5, 0xab9}, {0xabc, 0xac5}, {0xac7, 0xac9}, {0xacb, 0xacd},
|
||||
{0xae0, 0xae3}, {0xae6, 0xaf1}, {0xb01, 0xb03}, {0xb05, 0xb0c},
|
||||
{0xb13, 0xb28}, {0xb2a, 0xb30}, {0xb35, 0xb39}, {0xb3c, 0xb44},
|
||||
{0xb4b, 0xb4d}, {0xb5f, 0xb63}, {0xb66, 0xb77}, {0xb85, 0xb8a},
|
||||
{0xb8e, 0xb90}, {0xb92, 0xb95}, {0xba8, 0xbaa}, {0xbae, 0xbb9},
|
||||
{0xbbe, 0xbc2}, {0xbc6, 0xbc8}, {0xbca, 0xbcd}, {0xbe6, 0xbfa},
|
||||
{0xc00, 0xc03}, {0xc05, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
|
||||
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
|
||||
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc78, 0xc83},
|
||||
{0xc85, 0xc8c}, {0xc8e, 0xc90}, {0xc92, 0xca8}, {0xcaa, 0xcb3},
|
||||
{0xcb5, 0xcb9}, {0xcbc, 0xcc4}, {0xcc6, 0xcc8}, {0xcca, 0xccd},
|
||||
{0xce0, 0xce3}, {0xce6, 0xcef}, {0xd01, 0xd03}, {0xd05, 0xd0c},
|
||||
{0xd0e, 0xd10}, {0xd12, 0xd3a}, {0xd3d, 0xd44}, {0xd46, 0xd48},
|
||||
{0xd4a, 0xd4f}, {0xd54, 0xd63}, {0xd66, 0xd7f}, {0xd85, 0xd96},
|
||||
{0xd9a, 0xdb1}, {0xdb3, 0xdbb}, {0xdc0, 0xdc6}, {0xdcf, 0xdd4},
|
||||
{0xdd8, 0xddf}, {0xde6, 0xdef}, {0xdf2, 0xdf4}, {0xe01, 0xe3a},
|
||||
{0xe3f, 0xe5b}, {0xe94, 0xe97}, {0xe99, 0xe9f}, {0xea1, 0xea3},
|
||||
{0xead, 0xeb9}, {0xebb, 0xebd}, {0xec0, 0xec4}, {0xec8, 0xecd},
|
||||
{0xed0, 0xed9}, {0xedc, 0xedf}, {0xf00, 0xf47}, {0xf49, 0xf6c},
|
||||
{0xf71, 0xf97}, {0xf99, 0xfbc}, {0xfbe, 0xfcc}, {0xfce, 0xfda},
|
||||
{0x1000, 0x10c5}, {0x10d0, 0x1248}, {0x124a, 0x124d}, {0x1250, 0x1256},
|
||||
{0x125a, 0x125d}, {0x1260, 0x1288}, {0x128a, 0x128d}, {0x1290, 0x12b0},
|
||||
{0x12b2, 0x12b5}, {0x12b8, 0x12be}, {0x12c2, 0x12c5}, {0x12c8, 0x12d6},
|
||||
{0x12d8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135a}, {0x135d, 0x137c},
|
||||
{0x1380, 0x1399}, {0x13a0, 0x13f5}, {0x13f8, 0x13fd}, {0x1400, 0x167f},
|
||||
{0x1681, 0x169c}, {0x16a0, 0x16f8}, {0x1700, 0x170c}, {0x170e, 0x1714},
|
||||
{0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176c}, {0x176e, 0x1770},
|
||||
{0x1780, 0x17dd}, {0x17e0, 0x17e9}, {0x17f0, 0x17f9}, {0x1800, 0x180d},
|
||||
{0x1810, 0x1819}, {0x1820, 0x1877}, {0x1880, 0x18aa}, {0x18b0, 0x18f5},
|
||||
{0x1900, 0x191e}, {0x1920, 0x192b}, {0x1930, 0x193b}, {0x1944, 0x196d},
|
||||
{0x1970, 0x1974}, {0x1980, 0x19ab}, {0x19b0, 0x19c9}, {0x19d0, 0x19da},
|
||||
{0x19de, 0x1a1b}, {0x1a1e, 0x1a5e}, {0x1a60, 0x1a7c}, {0x1a7f, 0x1a89},
|
||||
{0x1a90, 0x1a99}, {0x1aa0, 0x1aad}, {0x1ab0, 0x1abe}, {0x1b00, 0x1b4b},
|
||||
{0x1b50, 0x1b7c}, {0x1b80, 0x1bf3}, {0x1bfc, 0x1c37}, {0x1c3b, 0x1c49},
|
||||
{0x1c4d, 0x1c88}, {0x1cc0, 0x1cc7}, {0x1cd0, 0x1cf6}, {0x1d00, 0x1df5},
|
||||
{0x1dfb, 0x1f15}, {0x1f18, 0x1f1d}, {0x1f20, 0x1f45}, {0x1f48, 0x1f4d},
|
||||
{0x1f50, 0x1f57}, {0x1f5f, 0x1f7d}, {0x1f80, 0x1fb4}, {0x1fb6, 0x1fc4},
|
||||
{0x1fc6, 0x1fd3}, {0x1fd6, 0x1fdb}, {0x1fdd, 0x1fef}, {0x1ff2, 0x1ff4},
|
||||
{0x1ff6, 0x1ffe}, {0x2010, 0x2027}, {0x2030, 0x205e}, {0x2074, 0x208e},
|
||||
{0x2090, 0x209c}, {0x20a0, 0x20be}, {0x20d0, 0x20f0}, {0x2100, 0x218b},
|
||||
{0x2190, 0x23fe}, {0x2400, 0x2426}, {0x2440, 0x244a}, {0x2460, 0x2b73},
|
||||
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd1},
|
||||
{0x2bec, 0x2bef}, {0x2c00, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
|
||||
{0x2cf9, 0x2d25}, {0x2d30, 0x2d67}, {0x2d7f, 0x2d96}, {0x2da0, 0x2da6},
|
||||
{0x2da8, 0x2dae}, {0x2db0, 0x2db6}, {0x2db8, 0x2dbe}, {0x2dc0, 0x2dc6},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e49},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e44},
|
||||
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312e},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312d},
|
||||
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fea}, {0xa000, 0xa48c},
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fd5}, {0xa000, 0xa48c},
|
||||
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7ae},
|
||||
{0xa7b0, 0xa7b7}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
|
||||
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa8fd}, {0xa900, 0xa953},
|
||||
@@ -698,7 +694,7 @@ static const crange graphRangeTable[] = {
|
||||
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
|
||||
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
|
||||
{0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x1032d, 0x1034a},
|
||||
{0x102a0, 0x102d0}, {0x102e0, 0x102fb}, {0x10300, 0x10323}, {0x10330, 0x1034a},
|
||||
{0x10350, 0x1037a}, {0x10380, 0x1039d}, {0x1039f, 0x103c3}, {0x103c8, 0x103d5},
|
||||
{0x10400, 0x1049d}, {0x104a0, 0x104a9}, {0x104b0, 0x104d3}, {0x104d8, 0x104fb},
|
||||
{0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
|
||||
@@ -721,38 +717,35 @@ static const crange graphRangeTable[] = {
|
||||
{0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd}, {0x11600, 0x11644},
|
||||
{0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b7}, {0x116c0, 0x116c9},
|
||||
{0x11700, 0x11719}, {0x1171d, 0x1172b}, {0x11730, 0x1173f}, {0x118a0, 0x118f2},
|
||||
{0x11a00, 0x11a47}, {0x11a50, 0x11a83}, {0x11a86, 0x11a9c}, {0x11a9e, 0x11aa2},
|
||||
{0x11ac0, 0x11af8}, {0x11c00, 0x11c08}, {0x11c0a, 0x11c36}, {0x11c38, 0x11c45},
|
||||
{0x11c50, 0x11c6c}, {0x11c70, 0x11c8f}, {0x11c92, 0x11ca7}, {0x11ca9, 0x11cb6},
|
||||
{0x11d00, 0x11d06}, {0x11d0b, 0x11d36}, {0x11d3f, 0x11d47}, {0x11d50, 0x11d59},
|
||||
{0x12000, 0x12399}, {0x12400, 0x1246e}, {0x12470, 0x12474}, {0x12480, 0x12543},
|
||||
{0x13000, 0x1342e}, {0x14400, 0x14646}, {0x16800, 0x16a38}, {0x16a40, 0x16a5e},
|
||||
{0x16a60, 0x16a69}, {0x16ad0, 0x16aed}, {0x16af0, 0x16af5}, {0x16b00, 0x16b45},
|
||||
{0x16b50, 0x16b59}, {0x16b5b, 0x16b61}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f},
|
||||
{0x16f00, 0x16f44}, {0x16f50, 0x16f7e}, {0x16f8f, 0x16f9f}, {0x17000, 0x187ec},
|
||||
{0x18800, 0x18af2}, {0x1b000, 0x1b11e}, {0x1b170, 0x1b2fb}, {0x1bc00, 0x1bc6a},
|
||||
{0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f},
|
||||
{0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8},
|
||||
{0x1d200, 0x1d245}, {0x1d300, 0x1d356}, {0x1d360, 0x1d371}, {0x1d400, 0x1d454},
|
||||
{0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3},
|
||||
{0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514}, {0x1d516, 0x1d51c},
|
||||
{0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
|
||||
{0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb}, {0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f},
|
||||
{0x1daa1, 0x1daaf}, {0x1e000, 0x1e006}, {0x1e008, 0x1e018}, {0x1e01b, 0x1e021},
|
||||
{0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4}, {0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a},
|
||||
{0x1e950, 0x1e959}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
|
||||
{0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f}, {0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72},
|
||||
{0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c}, {0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b},
|
||||
{0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9}, {0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b},
|
||||
{0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae}, {0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf},
|
||||
{0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c}, {0x1f110, 0x1f12e}, {0x1f130, 0x1f16b},
|
||||
{0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248},
|
||||
{0x1f260, 0x1f265}, {0x1f300, 0x1f6d4}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6f8},
|
||||
{0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
|
||||
{0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad}, {0x1f900, 0x1f90b},
|
||||
{0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
|
||||
{0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
|
||||
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
{0x18800, 0x18af2}, {0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88},
|
||||
{0x1bc90, 0x1bc99}, {0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126},
|
||||
{0x1d129, 0x1d172}, {0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d300, 0x1d356},
|
||||
{0x1d360, 0x1d371}, {0x1d400, 0x1d454}, {0x1d456, 0x1d49c}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d505}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d51e, 0x1d539}, {0x1d53b, 0x1d53e},
|
||||
{0x1d540, 0x1d544}, {0x1d54a, 0x1d550}, {0x1d552, 0x1d6a5}, {0x1d6a8, 0x1d7cb},
|
||||
{0x1d7ce, 0x1da8b}, {0x1da9b, 0x1da9f}, {0x1daa1, 0x1daaf}, {0x1e000, 0x1e006},
|
||||
{0x1e008, 0x1e018}, {0x1e01b, 0x1e021}, {0x1e026, 0x1e02a}, {0x1e800, 0x1e8c4},
|
||||
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94a}, {0x1e950, 0x1e959}, {0x1ee00, 0x1ee03},
|
||||
{0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32}, {0x1ee34, 0x1ee37}, {0x1ee4d, 0x1ee4f},
|
||||
{0x1ee67, 0x1ee6a}, {0x1ee6c, 0x1ee72}, {0x1ee74, 0x1ee77}, {0x1ee79, 0x1ee7c},
|
||||
{0x1ee80, 0x1ee89}, {0x1ee8b, 0x1ee9b}, {0x1eea1, 0x1eea3}, {0x1eea5, 0x1eea9},
|
||||
{0x1eeab, 0x1eebb}, {0x1f000, 0x1f02b}, {0x1f030, 0x1f093}, {0x1f0a0, 0x1f0ae},
|
||||
{0x1f0b1, 0x1f0bf}, {0x1f0c1, 0x1f0cf}, {0x1f0d1, 0x1f0f5}, {0x1f100, 0x1f10c},
|
||||
{0x1f110, 0x1f12e}, {0x1f130, 0x1f16b}, {0x1f170, 0x1f1ac}, {0x1f1e6, 0x1f202},
|
||||
{0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f300, 0x1f6d2}, {0x1f6e0, 0x1f6ec},
|
||||
{0x1f6f0, 0x1f6f6}, {0x1f700, 0x1f773}, {0x1f780, 0x1f7d4}, {0x1f800, 0x1f80b},
|
||||
{0x1f810, 0x1f847}, {0x1f850, 0x1f859}, {0x1f860, 0x1f887}, {0x1f890, 0x1f8ad},
|
||||
{0x1f910, 0x1f91e}, {0x1f920, 0x1f927}, {0x1f933, 0x1f93e}, {0x1f940, 0x1f94b},
|
||||
{0x1f950, 0x1f95e}, {0x1f980, 0x1f991}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734},
|
||||
{0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -762,23 +755,23 @@ static const chr graphCharTable[] = {
|
||||
0x38c, 0x589, 0x58a, 0x85e, 0x98f, 0x990, 0x9b2, 0x9c7, 0x9c8,
|
||||
0x9d7, 0x9dc, 0x9dd, 0xa0f, 0xa10, 0xa32, 0xa33, 0xa35, 0xa36,
|
||||
0xa38, 0xa39, 0xa3c, 0xa47, 0xa48, 0xa51, 0xa5e, 0xab2, 0xab3,
|
||||
0xad0, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56, 0xb57,
|
||||
0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e, 0xb9f,
|
||||
0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6, 0xcde,
|
||||
0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81, 0xe82,
|
||||
0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa, 0xeab,
|
||||
0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940, 0x1f59,
|
||||
0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d, 0x2d6f, 0x2d70, 0xfb3e,
|
||||
0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
|
||||
0xad0, 0xaf9, 0xb0f, 0xb10, 0xb32, 0xb33, 0xb47, 0xb48, 0xb56,
|
||||
0xb57, 0xb5c, 0xb5d, 0xb82, 0xb83, 0xb99, 0xb9a, 0xb9c, 0xb9e,
|
||||
0xb9f, 0xba3, 0xba4, 0xbd0, 0xbd7, 0xc55, 0xc56, 0xcd5, 0xcd6,
|
||||
0xcde, 0xcf1, 0xcf2, 0xd82, 0xd83, 0xdbd, 0xdca, 0xdd6, 0xe81,
|
||||
0xe82, 0xe84, 0xe87, 0xe88, 0xe8a, 0xe8d, 0xea5, 0xea7, 0xeaa,
|
||||
0xeab, 0xec6, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x1772, 0x1773, 0x1940,
|
||||
0x1cf8, 0x1cf9, 0x1f59, 0x1f5b, 0x1f5d, 0x2070, 0x2071, 0x2d27, 0x2d2d,
|
||||
0x2d6f, 0x2d70, 0xfb3e, 0xfb40, 0xfb41, 0xfb43, 0xfb44, 0xfffc, 0xfffd
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1003c, 0x1003d, 0x101a0, 0x1056f, 0x10808, 0x10837, 0x10838, 0x1083c, 0x108f4,
|
||||
0x108f5, 0x1093f, 0x10a05, 0x10a06, 0x11288, 0x1130f, 0x11310, 0x11332, 0x11333,
|
||||
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x11d08, 0x11d09,
|
||||
0x11d3a, 0x11d3c, 0x11d3d, 0x16a6e, 0x16a6f, 0x16fe0, 0x16fe1, 0x1d49e, 0x1d49f,
|
||||
0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f,
|
||||
0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49,
|
||||
0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f,
|
||||
0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e, 0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f9c0
|
||||
0x11347, 0x11348, 0x11350, 0x11357, 0x1145b, 0x1145d, 0x118ff, 0x16a6e, 0x16a6f,
|
||||
0x16fe0, 0x1b000, 0x1b001, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb,
|
||||
0x1d546, 0x1e023, 0x1e024, 0x1e95e, 0x1e95f, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27,
|
||||
0x1ee39, 0x1ee3b, 0x1ee42, 0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54,
|
||||
0x1ee57, 0x1ee59, 0x1ee5b, 0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e,
|
||||
0x1eef0, 0x1eef1, 0x1f250, 0x1f251, 0x1f930, 0x1f9c0
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
@@ -70,6 +70,7 @@
|
||||
*/
|
||||
|
||||
#define NOTREACHED 0
|
||||
#define xxx 1
|
||||
|
||||
#define DUPMAX _POSIX2_RE_DUP_MAX
|
||||
#define DUPINF (DUPMAX+1)
|
||||
|
||||
+59
-56
@@ -32,7 +32,7 @@ declare 0 {
|
||||
const char *version, const void *clientData)
|
||||
}
|
||||
declare 1 {
|
||||
const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version, int exact,
|
||||
void *clientDataPtr)
|
||||
}
|
||||
@@ -154,7 +154,7 @@ declare 35 {
|
||||
}
|
||||
declare 36 {
|
||||
int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
|
||||
CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
|
||||
}
|
||||
declare 37 {
|
||||
int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
|
||||
@@ -285,7 +285,7 @@ declare 75 {
|
||||
declare 76 {
|
||||
void Tcl_BackgroundError(Tcl_Interp *interp)
|
||||
}
|
||||
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
|
||||
declare 77 {
|
||||
char Tcl_Backslash(const char *src, int *readPtr)
|
||||
}
|
||||
declare 78 {
|
||||
@@ -306,7 +306,7 @@ declare 82 {
|
||||
int Tcl_CommandComplete(const char *cmd)
|
||||
}
|
||||
declare 83 {
|
||||
char *Tcl_Concat(int argc, const char *const *argv)
|
||||
char *Tcl_Concat(int argc, CONST84 char *const *argv)
|
||||
}
|
||||
declare 84 {
|
||||
int Tcl_ConvertElement(const char *src, char *dst, int flags)
|
||||
@@ -318,7 +318,7 @@ declare 85 {
|
||||
declare 86 {
|
||||
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
|
||||
Tcl_Interp *target, const char *targetCmd, int argc,
|
||||
const char *const *argv)
|
||||
CONST84 char *const *argv)
|
||||
}
|
||||
declare 87 {
|
||||
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
|
||||
@@ -352,7 +352,7 @@ declare 93 {
|
||||
declare 94 {
|
||||
Tcl_Interp *Tcl_CreateInterp(void)
|
||||
}
|
||||
declare 95 {deprecated {}} {
|
||||
declare 95 {
|
||||
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
|
||||
int numArgs, Tcl_ValueType *argTypes,
|
||||
Tcl_MathProc *proc, ClientData clientData)
|
||||
@@ -461,14 +461,15 @@ declare 126 {
|
||||
int Tcl_Eof(Tcl_Channel chan)
|
||||
}
|
||||
declare 127 {
|
||||
const char *Tcl_ErrnoId(void)
|
||||
CONST84_RETURN char *Tcl_ErrnoId(void)
|
||||
}
|
||||
declare 128 {
|
||||
const char *Tcl_ErrnoMsg(int err)
|
||||
CONST84_RETURN char *Tcl_ErrnoMsg(int err)
|
||||
}
|
||||
declare 129 {
|
||||
int Tcl_Eval(Tcl_Interp *interp, const char *script)
|
||||
}
|
||||
# This is obsolete, use Tcl_FSEvalFile
|
||||
declare 130 {
|
||||
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
|
||||
}
|
||||
@@ -528,12 +529,12 @@ declare 147 {
|
||||
}
|
||||
declare 148 {
|
||||
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
|
||||
int *argcPtr, const char ***argvPtr)
|
||||
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
|
||||
int *argcPtr, CONST84 char ***argvPtr)
|
||||
}
|
||||
declare 149 {
|
||||
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
|
||||
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
|
||||
int *objcPtr, Tcl_Obj ***objv)
|
||||
}
|
||||
declare 150 {
|
||||
@@ -558,7 +559,7 @@ declare 155 {
|
||||
int Tcl_GetChannelMode(Tcl_Channel chan)
|
||||
}
|
||||
declare 156 {
|
||||
const char *Tcl_GetChannelName(Tcl_Channel chan)
|
||||
CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
|
||||
}
|
||||
declare 157 {
|
||||
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
|
||||
@@ -572,14 +573,14 @@ declare 159 {
|
||||
Tcl_CmdInfo *infoPtr)
|
||||
}
|
||||
declare 160 {
|
||||
const char *Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
Tcl_Command command)
|
||||
}
|
||||
declare 161 {
|
||||
int Tcl_GetErrno(void)
|
||||
}
|
||||
declare 162 {
|
||||
const char *Tcl_GetHostName(void)
|
||||
CONST84_RETURN char *Tcl_GetHostName(void)
|
||||
}
|
||||
declare 163 {
|
||||
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
|
||||
@@ -622,14 +623,14 @@ declare 173 {
|
||||
Tcl_Channel Tcl_GetStdChannel(int type)
|
||||
}
|
||||
declare 174 {
|
||||
const char *Tcl_GetStringResult(Tcl_Interp *interp)
|
||||
CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
|
||||
}
|
||||
declare 175 {
|
||||
const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags)
|
||||
}
|
||||
declare 176 {
|
||||
const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, int flags)
|
||||
}
|
||||
declare 177 {
|
||||
@@ -662,7 +663,7 @@ declare 185 {
|
||||
}
|
||||
# Obsolete, use Tcl_FSJoinPath
|
||||
declare 186 {
|
||||
char *Tcl_JoinPath(int argc, const char *const *argv,
|
||||
char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
|
||||
Tcl_DString *resultPtr)
|
||||
}
|
||||
declare 187 {
|
||||
@@ -685,7 +686,7 @@ declare 191 {
|
||||
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
|
||||
}
|
||||
declare 192 {
|
||||
char *Tcl_Merge(int argc, const char *const *argv)
|
||||
char *Tcl_Merge(int argc, CONST84 char *const *argv)
|
||||
}
|
||||
declare 193 {
|
||||
Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
|
||||
@@ -703,7 +704,7 @@ declare 196 {
|
||||
}
|
||||
declare 197 {
|
||||
Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
|
||||
const char **argv, int flags)
|
||||
CONST84 char **argv, int flags)
|
||||
}
|
||||
# This is obsolete, use Tcl_FSOpenFileChannel
|
||||
declare 198 {
|
||||
@@ -729,7 +730,7 @@ declare 203 {
|
||||
int Tcl_PutEnv(const char *assignment)
|
||||
}
|
||||
declare 204 {
|
||||
const char *Tcl_PosixError(Tcl_Interp *interp)
|
||||
CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
|
||||
}
|
||||
declare 205 {
|
||||
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
|
||||
@@ -765,7 +766,7 @@ declare 214 {
|
||||
}
|
||||
declare 215 {
|
||||
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
|
||||
const char **startPtr, const char **endPtr)
|
||||
CONST84 char **startPtr, CONST84 char **endPtr)
|
||||
}
|
||||
declare 216 {
|
||||
void Tcl_Release(ClientData clientData)
|
||||
@@ -779,7 +780,8 @@ declare 218 {
|
||||
declare 219 {
|
||||
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
|
||||
}
|
||||
declare 220 {deprecated {}} {
|
||||
# Obsolete
|
||||
declare 220 {
|
||||
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
|
||||
}
|
||||
declare 221 {
|
||||
@@ -835,29 +837,29 @@ declare 236 {
|
||||
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
|
||||
}
|
||||
declare 237 {
|
||||
const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *newValue, int flags)
|
||||
}
|
||||
declare 238 {
|
||||
const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, const char *newValue, int flags)
|
||||
}
|
||||
declare 239 {
|
||||
const char *Tcl_SignalId(int sig)
|
||||
CONST84_RETURN char *Tcl_SignalId(int sig)
|
||||
}
|
||||
declare 240 {
|
||||
const char *Tcl_SignalMsg(int sig)
|
||||
CONST84_RETURN char *Tcl_SignalMsg(int sig)
|
||||
}
|
||||
declare 241 {
|
||||
void Tcl_SourceRCFile(Tcl_Interp *interp)
|
||||
}
|
||||
declare 242 {
|
||||
int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
|
||||
const char ***argvPtr)
|
||||
CONST84 char ***argvPtr)
|
||||
}
|
||||
# Obsolete, use Tcl_FSSplitPath
|
||||
declare 243 {
|
||||
void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
|
||||
void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
|
||||
}
|
||||
declare 244 {
|
||||
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
|
||||
@@ -866,7 +868,8 @@ declare 244 {
|
||||
declare 245 {
|
||||
int Tcl_StringMatch(const char *str, const char *pattern)
|
||||
}
|
||||
declare 246 {deprecated {}} {
|
||||
# Obsolete
|
||||
declare 246 {
|
||||
int Tcl_TellOld(Tcl_Channel chan)
|
||||
}
|
||||
declare 247 {
|
||||
@@ -942,25 +945,25 @@ declare 265 {
|
||||
declare 266 {
|
||||
void Tcl_ValidateAllMemory(const char *file, int line)
|
||||
}
|
||||
declare 267 {deprecated {see TIP #422}} {
|
||||
declare 267 {
|
||||
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
|
||||
}
|
||||
declare 268 {deprecated {see TIP #422}} {
|
||||
declare 268 {
|
||||
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
|
||||
}
|
||||
declare 269 {
|
||||
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
|
||||
}
|
||||
declare 270 {
|
||||
const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
const char **termPtr)
|
||||
CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
CONST84 char **termPtr)
|
||||
}
|
||||
declare 271 {
|
||||
const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
declare 272 {
|
||||
const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version, int exact,
|
||||
void *clientDataPtr)
|
||||
}
|
||||
@@ -970,19 +973,19 @@ declare 273 {
|
||||
}
|
||||
# TIP #268: The internally used new Require function is in slot 573.
|
||||
declare 274 {
|
||||
const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
declare 275 {deprecated {see TIP #422}} {
|
||||
declare 275 {
|
||||
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
|
||||
}
|
||||
declare 276 {deprecated {see TIP #422}} {
|
||||
declare 276 {
|
||||
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
|
||||
}
|
||||
declare 277 {
|
||||
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
|
||||
}
|
||||
declare 278 {deprecated {see TIP #422}} {
|
||||
declare 278 {
|
||||
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
|
||||
}
|
||||
declare 279 {
|
||||
@@ -1056,7 +1059,7 @@ declare 293 {
|
||||
int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
|
||||
}
|
||||
declare 294 {
|
||||
TCL_NORETURN void Tcl_ExitThread(int status)
|
||||
void Tcl_ExitThread(int status)
|
||||
}
|
||||
declare 295 {
|
||||
int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding,
|
||||
@@ -1084,7 +1087,7 @@ declare 301 {
|
||||
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
|
||||
}
|
||||
declare 302 {
|
||||
const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
|
||||
CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
|
||||
}
|
||||
declare 303 {
|
||||
void Tcl_GetEncodingNames(Tcl_Interp *interp)
|
||||
@@ -1160,7 +1163,7 @@ declare 324 {
|
||||
int Tcl_UniCharToUtf(int ch, char *buf)
|
||||
}
|
||||
declare 325 {
|
||||
const char *Tcl_UtfAtIndex(const char *src, int index)
|
||||
CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
|
||||
}
|
||||
declare 326 {
|
||||
int Tcl_UtfCharComplete(const char *src, int length)
|
||||
@@ -1169,16 +1172,16 @@ declare 327 {
|
||||
int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
|
||||
}
|
||||
declare 328 {
|
||||
const char *Tcl_UtfFindFirst(const char *src, int ch)
|
||||
CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
|
||||
}
|
||||
declare 329 {
|
||||
const char *Tcl_UtfFindLast(const char *src, int ch)
|
||||
CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
|
||||
}
|
||||
declare 330 {
|
||||
const char *Tcl_UtfNext(const char *src)
|
||||
CONST84_RETURN char *Tcl_UtfNext(const char *src)
|
||||
}
|
||||
declare 331 {
|
||||
const char *Tcl_UtfPrev(const char *src, const char *start)
|
||||
CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
|
||||
}
|
||||
declare 332 {
|
||||
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
|
||||
@@ -1211,10 +1214,10 @@ declare 339 {
|
||||
declare 340 {
|
||||
char *Tcl_GetString(Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
|
||||
const char *Tcl_GetDefaultEncodingDir(void)
|
||||
declare 341 {
|
||||
CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
|
||||
}
|
||||
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
|
||||
declare 342 {
|
||||
void Tcl_SetDefaultEncodingDir(const char *path)
|
||||
}
|
||||
declare 343 {
|
||||
@@ -1263,7 +1266,7 @@ declare 356 {
|
||||
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
|
||||
int flags)
|
||||
}
|
||||
declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
|
||||
declare 357 {
|
||||
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
int count)
|
||||
}
|
||||
@@ -1276,7 +1279,7 @@ declare 359 {
|
||||
}
|
||||
declare 360 {
|
||||
int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
|
||||
Tcl_Parse *parsePtr, int append, const char **termPtr)
|
||||
Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
|
||||
}
|
||||
declare 361 {
|
||||
int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
|
||||
@@ -1289,7 +1292,7 @@ declare 362 {
|
||||
declare 363 {
|
||||
int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
|
||||
int numBytes, Tcl_Parse *parsePtr, int append,
|
||||
const char **termPtr)
|
||||
CONST84 char **termPtr)
|
||||
}
|
||||
declare 364 {
|
||||
int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
|
||||
@@ -1405,7 +1408,7 @@ declare 397 {
|
||||
int Tcl_ChannelBuffered(Tcl_Channel chan)
|
||||
}
|
||||
declare 398 {
|
||||
const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
|
||||
CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
|
||||
}
|
||||
declare 399 {
|
||||
Tcl_ChannelTypeVersion Tcl_ChannelVersion(
|
||||
@@ -1545,12 +1548,12 @@ declare 434 {
|
||||
}
|
||||
|
||||
# TIP#15 (math function introspection) dkf
|
||||
declare 435 {deprecated {}} {
|
||||
declare 435 {
|
||||
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
|
||||
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
|
||||
}
|
||||
declare 436 {deprecated {}} {
|
||||
declare 436 {
|
||||
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
|
||||
}
|
||||
|
||||
|
||||
+127
-92
@@ -41,6 +41,7 @@ extern "C" {
|
||||
* unix/configure.ac (2 LOC Major, 2 LOC minor, 1 LOC patch)
|
||||
* win/configure.ac (as above)
|
||||
* win/tcl.m4 (not patchlevel)
|
||||
* win/makefile.bc (not patchlevel) 2 LOC
|
||||
* README (sections 0 and 2, with and without separator)
|
||||
* macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
|
||||
* macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
|
||||
@@ -55,12 +56,11 @@ extern "C" {
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 7
|
||||
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 2
|
||||
#define TCL_RELEASE_SERIAL 0
|
||||
|
||||
#define TCL_VERSION "8.7"
|
||||
#define TCL_PATCH_LEVEL "8.7a2"
|
||||
#define TCL_PATCH_LEVEL "8.7a0"
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* The following definitions set up the proper options for Windows compilers.
|
||||
@@ -89,7 +89,6 @@ extern "C" {
|
||||
# define JOIN(a,b) JOIN1(a,b)
|
||||
# define JOIN1(a,b) a##b
|
||||
#endif
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
* A special definition used to allow this header file to be included from
|
||||
@@ -137,11 +136,11 @@ extern "C" {
|
||||
*/
|
||||
|
||||
#include <stdarg.h>
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define TCL_VARARGS(type, name) (type name, ...)
|
||||
# define TCL_VARARGS_DEF(type, name) (type name, ...)
|
||||
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#endif
|
||||
#if defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
|
||||
# define TCL_NORETURN __attribute__ ((noreturn))
|
||||
@@ -254,9 +253,10 @@ extern "C" {
|
||||
* New code should use prototypes.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# undef _ANSI_ARGS_
|
||||
# define _ANSI_ARGS_(x) x
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Definitions that allow this header file to be used either with or without
|
||||
@@ -266,14 +266,34 @@ extern "C" {
|
||||
#ifndef INLINE
|
||||
# define INLINE
|
||||
#endif
|
||||
|
||||
#ifdef NO_CONST
|
||||
# ifndef const
|
||||
# define const
|
||||
# endif
|
||||
#endif
|
||||
#ifndef CONST
|
||||
# define CONST const
|
||||
#endif
|
||||
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#ifdef USE_NON_CONST
|
||||
# ifdef USE_COMPAT_CONST
|
||||
# error define at most one of USE_NON_CONST and USE_COMPAT_CONST
|
||||
# endif
|
||||
# define CONST84
|
||||
# define CONST84_RETURN
|
||||
#else
|
||||
# ifdef USE_COMPAT_CONST
|
||||
# define CONST84
|
||||
# define CONST84_RETURN const
|
||||
# else
|
||||
# define CONST84 const
|
||||
# define CONST84_RETURN const
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifndef CONST86
|
||||
# define CONST86 const
|
||||
# define CONST86 CONST84
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -297,7 +317,6 @@ extern "C" {
|
||||
* VOID. This block is skipped under Cygwin and Mingw.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
|
||||
#ifndef VOID
|
||||
#define VOID void
|
||||
@@ -313,16 +332,23 @@ typedef long LONG;
|
||||
*/
|
||||
|
||||
#ifndef __VXWORKS__
|
||||
# define VOID void
|
||||
# ifndef NO_VOID
|
||||
# define VOID void
|
||||
# else
|
||||
# define VOID char
|
||||
# endif
|
||||
#endif
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
|
||||
|
||||
/*
|
||||
* Miscellaneous declarations.
|
||||
*/
|
||||
|
||||
#ifndef _CLIENTDATA
|
||||
typedef void *ClientData;
|
||||
# ifndef NO_VOID
|
||||
typedef void *ClientData;
|
||||
# else
|
||||
typedef int *ClientData;
|
||||
# endif
|
||||
# define _CLIENTDATA
|
||||
#endif
|
||||
|
||||
@@ -350,8 +376,8 @@ typedef long LONG;
|
||||
* we have one, we can have the other.)
|
||||
*
|
||||
* Also defines the following macros:
|
||||
* TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a
|
||||
* LP64 system such as modern Solaris or Linux ... not including Win64)
|
||||
* TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a real
|
||||
* 64-bit system.)
|
||||
* Tcl_WideAsLong - forgetful converter from wideInt to long.
|
||||
* Tcl_LongAsWide - sign-extending converter from long to wideInt.
|
||||
* Tcl_WideAsDouble - converter from wideInt to double.
|
||||
@@ -368,45 +394,56 @@ typedef long LONG;
|
||||
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
|
||||
# if defined(_WIN32)
|
||||
# define TCL_WIDE_INT_TYPE __int64
|
||||
# define TCL_LL_MODIFIER "I64"
|
||||
# if defined(_WIN64)
|
||||
# define TCL_Z_MODIFIER "I"
|
||||
# endif
|
||||
# ifdef __BORLANDC__
|
||||
# define TCL_LL_MODIFIER "L"
|
||||
# else /* __BORLANDC__ */
|
||||
# define TCL_LL_MODIFIER "I64"
|
||||
# endif /* __BORLANDC__ */
|
||||
# elif defined(__GNUC__)
|
||||
# define TCL_Z_MODIFIER "z"
|
||||
# define TCL_WIDE_INT_TYPE long long
|
||||
# define TCL_LL_MODIFIER "ll"
|
||||
# else /* ! _WIN32 && ! __GNUC__ */
|
||||
/*
|
||||
* Don't know what platform it is and configure hasn't discovered what is
|
||||
* going on for us. Try to guess...
|
||||
*/
|
||||
# include <limits.h>
|
||||
# if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
|
||||
# if (INT_MAX < LONG_MAX)
|
||||
# define TCL_WIDE_INT_IS_LONG 1
|
||||
# else
|
||||
# define TCL_WIDE_INT_TYPE long long
|
||||
# endif
|
||||
# endif /* _WIN32 */
|
||||
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
#ifndef TCL_WIDE_INT_TYPE
|
||||
# define TCL_WIDE_INT_TYPE long long
|
||||
#endif /* !TCL_WIDE_INT_TYPE */
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
# undef TCL_WIDE_INT_TYPE
|
||||
# define TCL_WIDE_INT_TYPE long
|
||||
#endif /* TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
typedef TCL_WIDE_INT_TYPE Tcl_WideInt;
|
||||
typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
|
||||
#ifndef TCL_LL_MODIFIER
|
||||
# define TCL_LL_MODIFIER "ll"
|
||||
#endif /* !TCL_LL_MODIFIER */
|
||||
#ifndef TCL_Z_MODIFIER
|
||||
# if defined(__GNUC__) && !defined(_WIN32)
|
||||
# define TCL_Z_MODIFIER "z"
|
||||
# else
|
||||
# define TCL_Z_MODIFIER ""
|
||||
# endif
|
||||
#endif /* !TCL_Z_MODIFIER */
|
||||
#define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
|
||||
#define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
|
||||
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
|
||||
#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
# define Tcl_WideAsLong(val) ((long)(val))
|
||||
# define Tcl_LongAsWide(val) ((long)(val))
|
||||
# define Tcl_WideAsDouble(val) ((double)((long)(val)))
|
||||
# define Tcl_DoubleAsWide(val) ((long)((double)(val)))
|
||||
# ifndef TCL_LL_MODIFIER
|
||||
# define TCL_LL_MODIFIER "l"
|
||||
# endif /* !TCL_LL_MODIFIER */
|
||||
#else /* TCL_WIDE_INT_IS_LONG */
|
||||
/*
|
||||
* The next short section of defines are only done when not running on Windows
|
||||
* or some other strange platform.
|
||||
*/
|
||||
# ifndef TCL_LL_MODIFIER
|
||||
# define TCL_LL_MODIFIER "ll"
|
||||
# endif /* !TCL_LL_MODIFIER */
|
||||
# define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
|
||||
# define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
|
||||
# define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
|
||||
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
|
||||
#endif /* TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
#if defined(_WIN32)
|
||||
# ifdef __BORLANDC__
|
||||
@@ -462,15 +499,37 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
*/
|
||||
|
||||
typedef struct Tcl_Interp
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
{
|
||||
/* TIP #330: Strongly discourage extensions from using the string
|
||||
* result. */
|
||||
#ifdef USE_INTERP_RESULT
|
||||
char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
|
||||
/* If the last command returned a string
|
||||
* result, this points to it. */
|
||||
void (*freeProc) (char *blockPtr)
|
||||
TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
|
||||
/* Zero means the string result is statically
|
||||
* allocated. TCL_DYNAMIC means it was
|
||||
* allocated with ckalloc and should be freed
|
||||
* with ckfree. Other values give the address
|
||||
* of function to invoke to free the result.
|
||||
* Tcl_Eval must free it before executing next
|
||||
* command. */
|
||||
#else
|
||||
char *resultDontUse; /* Don't use in extensions! */
|
||||
void (*freeProcDontUse) (char *); /* Don't use in extensions! */
|
||||
#endif
|
||||
#ifdef USE_INTERP_ERRORLINE
|
||||
int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
|
||||
/* When TCL_ERROR is returned, this gives the
|
||||
* line number within the command where the
|
||||
* error occurred (1 if first line). */
|
||||
#else
|
||||
int errorLineDontUse; /* Don't use in extensions! */
|
||||
#endif
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
Tcl_Interp;
|
||||
|
||||
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
|
||||
@@ -620,9 +679,7 @@ typedef struct stat *Tcl_OldStat_;
|
||||
#define TCL_BREAK 3
|
||||
#define TCL_CONTINUE 4
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#define TCL_RESULT_SIZE 200
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -638,7 +695,6 @@ typedef struct stat *Tcl_OldStat_;
|
||||
* Argument descriptors for math function callbacks in expressions:
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
typedef enum {
|
||||
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
|
||||
} Tcl_ValueType;
|
||||
@@ -650,10 +706,6 @@ typedef struct Tcl_Value {
|
||||
double doubleValue; /* Double-precision floating value. */
|
||||
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
|
||||
} Tcl_Value;
|
||||
#else
|
||||
#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
|
||||
#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Forward declaration of Tcl_Obj to prevent an error when the forward
|
||||
@@ -674,10 +726,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
|
||||
typedef void (Tcl_CloseProc) (ClientData data);
|
||||
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
|
||||
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int argc, const char *argv[]);
|
||||
int argc, CONST84 char *argv[]);
|
||||
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int level, char *command, Tcl_CmdProc *proc,
|
||||
ClientData cmdClientData, int argc, const char *argv[]);
|
||||
ClientData cmdClientData, int argc, CONST84 char *argv[]);
|
||||
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int level, const char *command, Tcl_Command commandInfo, int objc,
|
||||
struct Tcl_Obj *const *objv);
|
||||
@@ -714,7 +766,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData);
|
||||
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
|
||||
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
|
||||
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
const char *part1, const char *part2, int flags);
|
||||
CONST84 char *part1, CONST84 char *part2, int flags);
|
||||
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
const char *oldName, const char *newName, int flags);
|
||||
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
|
||||
@@ -825,7 +877,7 @@ typedef struct Tcl_SavedResult {
|
||||
char *appendResult;
|
||||
int appendAvl;
|
||||
int appendUsed;
|
||||
char resultSpace[200+1];
|
||||
char resultSpace[TCL_RESULT_SIZE+1];
|
||||
} Tcl_SavedResult;
|
||||
|
||||
/*
|
||||
@@ -951,9 +1003,7 @@ typedef struct Tcl_DString {
|
||||
|
||||
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
|
||||
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define Tcl_DStringTrunc Tcl_DStringSetLength
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#define Tcl_DStringTrunc Tcl_DStringSetLength
|
||||
|
||||
/*
|
||||
* Definitions for the maximum number of digits of precision that may be
|
||||
@@ -1079,9 +1129,9 @@ typedef struct Tcl_DString {
|
||||
* give the flag)
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
# define TCL_PARSE_PART1 0x400
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Types for linked variables:
|
||||
@@ -1097,13 +1147,8 @@ typedef struct Tcl_DString {
|
||||
#define TCL_LINK_SHORT 8
|
||||
#define TCL_LINK_USHORT 9
|
||||
#define TCL_LINK_UINT 10
|
||||
#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__)
|
||||
#define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
|
||||
#define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
|
||||
#else
|
||||
#define TCL_LINK_LONG 11
|
||||
#define TCL_LINK_ULONG 12
|
||||
#endif
|
||||
#define TCL_LINK_FLOAT 13
|
||||
#define TCL_LINK_WIDE_UINT 14
|
||||
#define TCL_LINK_READ_ONLY 0x80
|
||||
@@ -1298,8 +1343,8 @@ typedef struct Tcl_HashSearch {
|
||||
typedef struct {
|
||||
void *next; /* Search position for underlying hash
|
||||
* table. */
|
||||
unsigned int epoch; /* Epoch marker for dictionary being searched,
|
||||
* or 0 if search has terminated. */
|
||||
int epoch; /* Epoch marker for dictionary being searched,
|
||||
* or -1 if search has terminated. */
|
||||
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
|
||||
} Tcl_DictSearch;
|
||||
|
||||
@@ -1432,14 +1477,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData,
|
||||
typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf,
|
||||
int toRead, int *errorCodePtr);
|
||||
typedef int (Tcl_DriverOutputProc) (ClientData instanceData,
|
||||
const char *buf, int toWrite, int *errorCodePtr);
|
||||
CONST84 char *buf, int toWrite, int *errorCodePtr);
|
||||
typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset,
|
||||
int mode, int *errorCodePtr);
|
||||
typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData,
|
||||
Tcl_Interp *interp, const char *optionName,
|
||||
const char *value);
|
||||
typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData,
|
||||
Tcl_Interp *interp, const char *optionName,
|
||||
Tcl_Interp *interp, CONST84 char *optionName,
|
||||
Tcl_DString *dsPtr);
|
||||
typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask);
|
||||
typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData,
|
||||
@@ -1932,7 +1977,7 @@ typedef struct Tcl_Token {
|
||||
* 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 preceded by one
|
||||
* 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
|
||||
@@ -2217,8 +2262,6 @@ typedef struct mp_int mp_int;
|
||||
#define MP_INT_DECLARED
|
||||
typedef unsigned int mp_digit;
|
||||
#define MP_DIGIT_DECLARED
|
||||
typedef unsigned TCL_WIDE_INT_TYPE mp_word;
|
||||
#define MP_WORD_DECLARED
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2363,27 +2406,14 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
const char *version, int epoch, int revision);
|
||||
|
||||
#ifdef USE_TCL_STUBS
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
(Tcl_InitStubs)(interp, version, \
|
||||
#define Tcl_InitStubs(interp, version, exact) \
|
||||
(Tcl_InitStubs)(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
|
||||
TCL_STUB_MAGIC)
|
||||
#else
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
(Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \
|
||||
1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
|
||||
TCL_STUB_MAGIC)
|
||||
#endif
|
||||
#else
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
Tcl_PkgInitStubsCheck(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
|
||||
#else
|
||||
# define Tcl_InitStubs(interp, version, exact) \
|
||||
Tcl_PkgInitStubsCheck(interp, TCL_PATCH_LEVEL, \
|
||||
1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
|
||||
#endif
|
||||
#define Tcl_InitStubs(interp, version, exact) \
|
||||
Tcl_PkgInitStubsCheck(interp, version, \
|
||||
(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -2504,16 +2534,22 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
|
||||
# undef Tcl_NewBooleanObj
|
||||
# define Tcl_NewBooleanObj(val) \
|
||||
Tcl_DbNewLongObj((val)!=0, __FILE__, __LINE__)
|
||||
Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
|
||||
# undef Tcl_NewByteArrayObj
|
||||
# define Tcl_NewByteArrayObj(bytes, len) \
|
||||
Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
|
||||
# undef Tcl_NewDoubleObj
|
||||
# define Tcl_NewDoubleObj(val) \
|
||||
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
|
||||
# undef Tcl_NewIntObj
|
||||
# define Tcl_NewIntObj(val) \
|
||||
Tcl_DbNewLongObj(val, __FILE__, __LINE__)
|
||||
# undef Tcl_NewListObj
|
||||
# define Tcl_NewListObj(objc, objv) \
|
||||
Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
|
||||
# undef Tcl_NewLongObj
|
||||
# define Tcl_NewLongObj(val) \
|
||||
Tcl_DbNewLongObj(val, __FILE__, __LINE__)
|
||||
# undef Tcl_NewObj
|
||||
# define Tcl_NewObj() \
|
||||
Tcl_DbNewObj(__FILE__, __LINE__)
|
||||
@@ -2576,10 +2612,10 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
* Deprecated Tcl functions:
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
/*
|
||||
* These function have been renamed. The old names are deprecated, but we
|
||||
* define these macros for backwards compatibility.
|
||||
* define these macros for backwards compatibilty.
|
||||
*/
|
||||
|
||||
# define Tcl_Ckalloc Tcl_Alloc
|
||||
@@ -2591,6 +2627,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
# define panic Tcl_Panic
|
||||
#endif
|
||||
# define panicVA Tcl_PanicVA
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -2601,8 +2638,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
|
||||
extern Tcl_AppInitProc Tcl_AppInit;
|
||||
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
#endif /* RC_INVOKED */
|
||||
|
||||
/*
|
||||
|
||||
+5
-5
@@ -661,14 +661,14 @@ mstats(
|
||||
|
||||
fprintf(stderr, "\nused:\t");
|
||||
for (i = 0; i < NBUCKETS; i++) {
|
||||
fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
|
||||
fprintf(stderr, " %" TCL_LL_MODIFIER "d", (Tcl_WideInt)numMallocs[i]);
|
||||
totalUsed += numMallocs[i] * (1 << (i + 3));
|
||||
}
|
||||
|
||||
fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
|
||||
totalUsed, totalFree);
|
||||
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
|
||||
MAXMALLOC, numMallocs[NBUCKETS]);
|
||||
fprintf(stderr, "\n\tTotal small in use: %" TCL_LL_MODIFIER "d, total free: %" TCL_LL_MODIFIER "d\n",
|
||||
(Tcl_WideInt)totalUsed, (Tcl_WideInt)totalFree);
|
||||
fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_LL_MODIFIER "d\n",
|
||||
MAXMALLOC, (Tcl_WideInt)numMallocs[NBUCKETS]);
|
||||
|
||||
Tcl_MutexUnlock(allocMutexPtr);
|
||||
}
|
||||
|
||||
+14
-35
@@ -137,8 +137,6 @@ typedef enum TalInstType {
|
||||
* ranges */
|
||||
ASSEM_BOOL, /* One Boolean operand */
|
||||
ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */
|
||||
ASSEM_CLOCK_READ, /* 1-byte unsigned-integer case number, in the
|
||||
* range 0-3 */
|
||||
ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must
|
||||
* be strictly positive, consumes N, produces
|
||||
* 1 */
|
||||
@@ -352,7 +350,6 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
{"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1},
|
||||
{"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1},
|
||||
{"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1},
|
||||
{"clockRead", ASSEM_CLOCK_READ, INST_CLOCK_READ, 0, 1},
|
||||
{"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
|
||||
{"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1},
|
||||
{"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1},
|
||||
@@ -1364,23 +1361,6 @@ AssembleOneLine(
|
||||
TclEmitInt4(localVar, envPtr);
|
||||
break;
|
||||
|
||||
case ASSEM_CLOCK_READ:
|
||||
if (parsePtr->numWords != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
|
||||
goto cleanup;
|
||||
}
|
||||
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
|
||||
goto cleanup;
|
||||
}
|
||||
if (opnd < 0 || opnd > 3) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj("operand must be [0..3]", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL);
|
||||
goto cleanup;
|
||||
}
|
||||
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
|
||||
break;
|
||||
|
||||
case ASSEM_CONCAT1:
|
||||
if (parsePtr->numWords != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
|
||||
@@ -2246,24 +2226,23 @@ GetListIndexOperand(
|
||||
Tcl_Token* tokenPtr = *tokenPtrPtr;
|
||||
/* INOUT: Pointer to the next token in the
|
||||
* source code */
|
||||
Tcl_Obj *value;
|
||||
int status;
|
||||
Tcl_Obj* intObj; /* Integer from the source code */
|
||||
int status; /* Tcl status return */
|
||||
|
||||
/* General operand validity check */
|
||||
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
|
||||
/*
|
||||
* Extract the next token as a string.
|
||||
*/
|
||||
|
||||
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* Convert to an integer, advance to the next token and return. */
|
||||
/*
|
||||
* NOTE: Indexing a list with an index before it yields the
|
||||
* same result as indexing after it, and might be more easily portable
|
||||
* when list size limits grow.
|
||||
*/
|
||||
status = TclIndexEncode(interp, value,
|
||||
TCL_INDEX_BEFORE,TCL_INDEX_BEFORE, result);
|
||||
|
||||
Tcl_DecrRefCount(value);
|
||||
/*
|
||||
* Convert to an integer, advance to the next token and return.
|
||||
*/
|
||||
|
||||
status = TclGetIntForIndex(interp, intObj, -2, result);
|
||||
Tcl_DecrRefCount(intObj);
|
||||
*tokenPtrPtr = TokenAfter(tokenPtr);
|
||||
return status;
|
||||
}
|
||||
@@ -4267,7 +4246,7 @@ AddBasicBlockRangeToErrorInfo(
|
||||
Tcl_AppendObjToErrorInfo(interp, lineNo);
|
||||
Tcl_AddErrorInfo(interp, " and ");
|
||||
if (bbPtr->successor1 != NULL) {
|
||||
TclSetIntObj(lineNo, bbPtr->successor1->startLine);
|
||||
Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
|
||||
Tcl_AppendObjToErrorInfo(interp, lineNo);
|
||||
} else {
|
||||
Tcl_AddErrorInfo(interp, "end of assembly code");
|
||||
|
||||
+146
-325
@@ -118,8 +118,6 @@ static Tcl_ObjCmdProc ExprEntierFunc;
|
||||
static Tcl_ObjCmdProc ExprFloorFunc;
|
||||
static Tcl_ObjCmdProc ExprIntFunc;
|
||||
static Tcl_ObjCmdProc ExprIsqrtFunc;
|
||||
static Tcl_ObjCmdProc ExprMaxFunc;
|
||||
static Tcl_ObjCmdProc ExprMinFunc;
|
||||
static Tcl_ObjCmdProc ExprRandFunc;
|
||||
static Tcl_ObjCmdProc ExprRoundFunc;
|
||||
static Tcl_ObjCmdProc ExprSqrtFunc;
|
||||
@@ -132,10 +130,8 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
|
||||
static Tcl_NRPostProc NRCoroutineExitCallback;
|
||||
static Tcl_NRPostProc NRCommand;
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
static Tcl_ObjCmdProc OldMathFuncProc;
|
||||
static void OldMathFuncDeleteProc(ClientData clientData);
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
static void ProcessUnexpectedResult(Tcl_Interp *interp,
|
||||
int returnCode);
|
||||
static int RewindCoroutine(CoroutineData *corPtr, int result);
|
||||
@@ -207,7 +203,7 @@ static const CmdInfo builtInCmds[] = {
|
||||
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
|
||||
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
|
||||
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
#endif
|
||||
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
|
||||
@@ -238,7 +234,7 @@ static const CmdInfo builtInCmds[] = {
|
||||
{"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
{"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE},
|
||||
{"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
{"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE},
|
||||
{"package", Tcl_PackageObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
{"proc", Tcl_ProcObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
{"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE},
|
||||
{"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE},
|
||||
@@ -269,6 +265,7 @@ static const CmdInfo builtInCmds[] = {
|
||||
{"cd", Tcl_CdObjCmd, NULL, NULL, 0},
|
||||
{"close", Tcl_CloseObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
{"eof", Tcl_EofObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
{"encoding", Tcl_EncodingObjCmd, NULL, NULL, 0},
|
||||
{"exec", Tcl_ExecObjCmd, NULL, NULL, 0},
|
||||
{"exit", Tcl_ExitObjCmd, NULL, NULL, 0},
|
||||
{"fblocked", Tcl_FblockedObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
@@ -325,8 +322,6 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
|
||||
{ "isqrt", ExprIsqrtFunc, NULL },
|
||||
{ "log", ExprUnaryFunc, (ClientData) log },
|
||||
{ "log10", ExprUnaryFunc, (ClientData) log10 },
|
||||
{ "max", ExprMaxFunc, NULL },
|
||||
{ "min", ExprMinFunc, NULL },
|
||||
{ "pow", ExprBinaryFunc, (ClientData) pow },
|
||||
{ "rand", ExprRandFunc, NULL },
|
||||
{ "round", ExprRoundFunc, NULL },
|
||||
@@ -516,11 +511,7 @@ Tcl_CreateInterp(void)
|
||||
iPtr = ckalloc(sizeof(Interp));
|
||||
interp = (Tcl_Interp *) iPtr;
|
||||
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
iPtr->result = &tclEmptyString;
|
||||
#else
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
#endif
|
||||
iPtr->freeProc = NULL;
|
||||
iPtr->errorLine = 0;
|
||||
iPtr->objResultPtr = Tcl_NewObj();
|
||||
@@ -580,11 +571,9 @@ Tcl_CreateInterp(void)
|
||||
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
|
||||
iPtr->lookupNsPtr = NULL;
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
iPtr->appendUsed = 0;
|
||||
#endif
|
||||
|
||||
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
|
||||
iPtr->packageUnknown = NULL;
|
||||
@@ -614,9 +603,7 @@ Tcl_CreateInterp(void)
|
||||
iPtr->emptyObjPtr = Tcl_NewObj();
|
||||
/* Another empty object. */
|
||||
Tcl_IncrRefCount(iPtr->emptyObjPtr);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
iPtr->resultSpace[0] = 0;
|
||||
#endif
|
||||
iPtr->threadId = Tcl_GetCurrentThread();
|
||||
|
||||
/* TIP #378 */
|
||||
@@ -803,23 +790,21 @@ Tcl_CreateInterp(void)
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the "array", "binary", "chan", "clock", "dict", "encoding",
|
||||
* "file", "info", "namespace" and "string" ensembles. Note that all these
|
||||
* commands (and their subcommands that are not present in the global
|
||||
* namespace) are wholly safe *except* for "clock", "encoding" and "file".
|
||||
* Create the "array", "binary", "chan", "dict", "file", "info",
|
||||
* "namespace" and "string" ensembles. Note that all these commands (and
|
||||
* their subcommands that are not present in the global namespace) are
|
||||
* wholly safe *except* for "file".
|
||||
*/
|
||||
|
||||
TclInitArrayCmd(interp);
|
||||
TclInitBinaryCmd(interp);
|
||||
TclInitChanCmd(interp);
|
||||
TclInitDictCmd(interp);
|
||||
TclInitEncodingCmd(interp);
|
||||
TclInitFileCmd(interp);
|
||||
TclInitInfoCmd(interp);
|
||||
TclInitNamespaceCmd(interp);
|
||||
TclInitStringCmd(interp);
|
||||
TclInitPrefixCmd(interp);
|
||||
TclInitProcessCmd(interp);
|
||||
|
||||
/*
|
||||
* Register "clock" subcommands. These *do* go through
|
||||
@@ -957,11 +942,9 @@ Tcl_CreateInterp(void)
|
||||
|
||||
Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
|
||||
Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Tcl_TraceVar2(interp, "tcl_precision", NULL,
|
||||
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
|
||||
TclPrecTraceProc, NULL);
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
TclpSetVariables(interp);
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
@@ -1044,7 +1027,6 @@ TclHideUnsafeCommands(
|
||||
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
|
||||
}
|
||||
}
|
||||
TclMakeEncodingCommandSafe(interp); /* Ugh! */
|
||||
TclMakeFileCommandSafe(interp); /* Ugh! */
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1080,7 +1062,7 @@ Tcl_CallWhenDeleted(
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
static Tcl_ThreadDataKey assocDataCounterKey;
|
||||
int *assocDataCounterPtr =
|
||||
Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
|
||||
Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
|
||||
int isNew;
|
||||
char buffer[32 + TCL_INTEGER_SPACE];
|
||||
AssocData *dPtr = ckalloc(sizeof(AssocData));
|
||||
@@ -1552,12 +1534,10 @@ DeleteInterpProc(
|
||||
if (iPtr->returnOpts) {
|
||||
Tcl_DecrRefCount(iPtr->returnOpts);
|
||||
}
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
iPtr->appendResult = NULL;
|
||||
}
|
||||
#endif
|
||||
TclFreePackageInfo(iPtr);
|
||||
while (iPtr->tracePtr != NULL) {
|
||||
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
|
||||
@@ -2062,11 +2042,11 @@ Tcl_CreateCommand(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
ImportRef *oldRefPtr = NULL;
|
||||
Namespace *nsPtr;
|
||||
Command *cmdPtr;
|
||||
Namespace *nsPtr, *dummy1, *dummy2;
|
||||
Command *cmdPtr, *refCmdPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
const char *tail;
|
||||
int isNew = 0, deleted = 0;
|
||||
int isNew;
|
||||
ImportedCmdData *dataPtr;
|
||||
|
||||
if (iPtr->flags & DELETED) {
|
||||
@@ -2079,52 +2059,32 @@ Tcl_CreateCommand(
|
||||
}
|
||||
|
||||
/*
|
||||
* If the command name we seek to create already exists, we need to
|
||||
* delete that first. That can be tricky in the presence of traces.
|
||||
* Loop until we no longer find an existing command in the way, or
|
||||
* until we've deleted one command and that didn't finish the job.
|
||||
* Determine where the command should reside. If its name contains
|
||||
* namespace qualifiers, we put it in the specified namespace; otherwise,
|
||||
* we always put it in the global namespace.
|
||||
*/
|
||||
|
||||
while (1) {
|
||||
/*
|
||||
* Determine where the command should reside. If its name contains
|
||||
* namespace qualifiers, we put it in the specified namespace;
|
||||
* otherwise, we always put it in the global namespace.
|
||||
*/
|
||||
|
||||
if (strstr(cmdName, "::") != NULL) {
|
||||
Namespace *dummy1, *dummy2;
|
||||
|
||||
TclGetNamespaceForQualName(interp, cmdName, NULL,
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
|
||||
if ((nsPtr == NULL) || (tail == NULL)) {
|
||||
return (Tcl_Command) NULL;
|
||||
}
|
||||
} else {
|
||||
nsPtr = iPtr->globalNsPtr;
|
||||
tail = cmdName;
|
||||
}
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
|
||||
if (isNew || deleted) {
|
||||
/*
|
||||
* isNew - No conflict with existing command.
|
||||
* deleted - We've already deleted a conflicting command
|
||||
*/
|
||||
break;
|
||||
if (strstr(cmdName, "::") != NULL) {
|
||||
TclGetNamespaceForQualName(interp, cmdName, NULL,
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
|
||||
if ((nsPtr == NULL) || (tail == NULL)) {
|
||||
return (Tcl_Command) NULL;
|
||||
}
|
||||
} else {
|
||||
nsPtr = iPtr->globalNsPtr;
|
||||
tail = cmdName;
|
||||
}
|
||||
|
||||
/* An existing command conflicts. Try to delete it.. */
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
if (!isNew) {
|
||||
/*
|
||||
* Be careful to preserve
|
||||
* Command already exists. Delete the old one. Be careful to preserve
|
||||
* any existing import links so we can restore them down below. That
|
||||
* way, you can redefine a command and its import status will remain
|
||||
* intact.
|
||||
*/
|
||||
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
cmdPtr->refCount++;
|
||||
if (cmdPtr->importRefPtr) {
|
||||
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
|
||||
@@ -2137,21 +2097,18 @@ Tcl_CreateCommand(
|
||||
cmdPtr->importRefPtr = NULL;
|
||||
}
|
||||
TclCleanupCommandMacro(cmdPtr);
|
||||
deleted = 1;
|
||||
}
|
||||
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
* the new command (if we try to delete it again, we could get
|
||||
* stuck in an infinite loop).
|
||||
*/
|
||||
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
}
|
||||
|
||||
if (!deleted) {
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
* the new command (if we try to delete it again, we could get
|
||||
* stuck in an infinite loop).
|
||||
*/
|
||||
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Command resolvers (per-interp, per-namespace) might have resolved
|
||||
* to a command for the given namespace scope with this command not
|
||||
@@ -2199,7 +2156,7 @@ Tcl_CreateCommand(
|
||||
if (oldRefPtr != NULL) {
|
||||
cmdPtr->importRefPtr = oldRefPtr;
|
||||
while (oldRefPtr != NULL) {
|
||||
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
|
||||
refCmdPtr = oldRefPtr->importedCmdPtr;
|
||||
dataPtr = refCmdPtr->objClientData;
|
||||
dataPtr->realCmdPtr = cmdPtr;
|
||||
oldRefPtr = oldRefPtr->nextPtr;
|
||||
@@ -2254,34 +2211,37 @@ Tcl_CreateObjCommand(
|
||||
* name. */
|
||||
ClientData clientData, /* Arbitrary value to pass to object
|
||||
* function. */
|
||||
Tcl_CmdDeleteProc *deleteProc
|
||||
Tcl_CmdDeleteProc *deleteProc)
|
||||
/* If not NULL, gives a function to call when
|
||||
* this command is deleted. */
|
||||
)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Namespace *nsPtr;
|
||||
ImportRef *oldRefPtr = NULL;
|
||||
Namespace *nsPtr, *dummy1, *dummy2;
|
||||
Command *cmdPtr, *refCmdPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
const char *tail;
|
||||
int isNew;
|
||||
ImportedCmdData *dataPtr;
|
||||
|
||||
if (iPtr->flags & DELETED) {
|
||||
/*
|
||||
* The interpreter is being deleted. Don't create any new commands;
|
||||
* it's not safe to muck with the interpreter anymore.
|
||||
*/
|
||||
|
||||
return (Tcl_Command) NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Determine where the command should reside. If its name contains
|
||||
* namespace qualifiers, we put it in the specified namespace;
|
||||
* otherwise, we always put it in the global namespace.
|
||||
* namespace qualifiers, we put it in the specified namespace; otherwise,
|
||||
* we always put it in the global namespace.
|
||||
*/
|
||||
|
||||
if (strstr(cmdName, "::") != NULL) {
|
||||
Namespace *dummy1, *dummy2;
|
||||
|
||||
TclGetNamespaceForQualName(interp, cmdName, NULL,
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
|
||||
if ((nsPtr == NULL) || (tail == NULL)) {
|
||||
return (Tcl_Command) NULL;
|
||||
}
|
||||
@@ -2290,50 +2250,13 @@ Tcl_CreateObjCommand(
|
||||
tail = cmdName;
|
||||
}
|
||||
|
||||
return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
|
||||
proc, clientData, deleteProc);
|
||||
}
|
||||
|
||||
Tcl_Command
|
||||
TclCreateObjCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName, /* Name of command, without any namespace components */
|
||||
Tcl_Namespace *namespace, /* The namespace to create the command in */
|
||||
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
|
||||
* name. */
|
||||
ClientData clientData, /* Arbitrary value to pass to object
|
||||
* function. */
|
||||
Tcl_CmdDeleteProc *deleteProc
|
||||
/* If not NULL, gives a function to call when
|
||||
* this command is deleted. */
|
||||
) {
|
||||
int deleted = 0, isNew = 0;
|
||||
Command *cmdPtr;
|
||||
ImportRef *oldRefPtr = NULL;
|
||||
ImportedCmdData *dataPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Namespace *nsPtr = (Namespace *) namespace;
|
||||
/*
|
||||
* If the command name we seek to create already exists, we need to
|
||||
* delete that first. That can be tricky in the presence of traces.
|
||||
* Loop until we no longer find an existing command in the way, or
|
||||
* until we've deleted one command and that didn't finish the job.
|
||||
*/
|
||||
while (1) {
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
|
||||
|
||||
if (isNew || deleted) {
|
||||
/*
|
||||
* isNew - No conflict with existing command.
|
||||
* deleted - We've already deleted a conflicting command
|
||||
*/
|
||||
break;
|
||||
}
|
||||
|
||||
|
||||
/* An existing command conflicts. Try to delete it.. */
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
TclInvalidateNsPath(nsPtr);
|
||||
if (!isNew) {
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
/* Command already exists. */
|
||||
|
||||
/*
|
||||
* [***] This is wrong. See Tcl Bug a16752c252.
|
||||
* However, this buggy behavior is kept under particular
|
||||
@@ -2363,32 +2286,25 @@ TclCreateObjCommandInNs (
|
||||
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
|
||||
}
|
||||
|
||||
/* Make sure namespace doesn't get deallocated. */
|
||||
cmdPtr->nsPtr->refCount++;
|
||||
|
||||
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
|
||||
nsPtr = (Namespace *) TclEnsureNamespace(interp,
|
||||
(Tcl_Namespace *)cmdPtr->nsPtr);
|
||||
TclNsDecrRefCount(cmdPtr->nsPtr);
|
||||
|
||||
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
|
||||
oldRefPtr = cmdPtr->importRefPtr;
|
||||
cmdPtr->importRefPtr = NULL;
|
||||
}
|
||||
TclCleanupCommandMacro(cmdPtr);
|
||||
deleted = 1;
|
||||
}
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
* the new command (if we try to delete it again, we could get
|
||||
* stuck in an infinite loop).
|
||||
*/
|
||||
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
}
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
* the new command (if we try to delete it again, we could get
|
||||
* stuck in an infinite loop).
|
||||
*/
|
||||
|
||||
if (!deleted) {
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Command resolvers (per-interp, per-namespace) might have resolved
|
||||
* to a command for the given namespace scope with this command not
|
||||
@@ -2399,7 +2315,7 @@ TclCreateObjCommandInNs (
|
||||
* commands.
|
||||
*/
|
||||
|
||||
TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
|
||||
TclInvalidateCmdLiteral(interp, tail, nsPtr);
|
||||
|
||||
/*
|
||||
* The list of command exported from the namespace might have changed.
|
||||
@@ -2408,7 +2324,6 @@ TclCreateObjCommandInNs (
|
||||
*/
|
||||
|
||||
TclInvalidateNsCmdLookup(nsPtr);
|
||||
TclInvalidateNsPath(nsPtr);
|
||||
}
|
||||
cmdPtr = ckalloc(sizeof(Command));
|
||||
Tcl_SetHashValue(hPtr, cmdPtr);
|
||||
@@ -2436,7 +2351,7 @@ TclCreateObjCommandInNs (
|
||||
if (oldRefPtr != NULL) {
|
||||
cmdPtr->importRefPtr = oldRefPtr;
|
||||
while (oldRefPtr != NULL) {
|
||||
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
|
||||
refCmdPtr = oldRefPtr->importedCmdPtr;
|
||||
dataPtr = refCmdPtr->objClientData;
|
||||
dataPtr->realCmdPtr = cmdPtr;
|
||||
oldRefPtr = oldRefPtr->nextPtr;
|
||||
@@ -2629,6 +2544,10 @@ TclRenameCommand(
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
cmdNsPtr = cmdPtr->nsPtr;
|
||||
oldFullName = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(oldFullName);
|
||||
Tcl_GetCommandFullName(interp, cmd, oldFullName);
|
||||
|
||||
/*
|
||||
* If the new command name is NULL or empty, delete the command. Do this
|
||||
@@ -2637,14 +2556,10 @@ TclRenameCommand(
|
||||
|
||||
if ((newName == NULL) || (*newName == '\0')) {
|
||||
Tcl_DeleteCommandFromToken(interp, cmd);
|
||||
return TCL_OK;
|
||||
result = TCL_OK;
|
||||
goto done;
|
||||
}
|
||||
|
||||
cmdNsPtr = cmdPtr->nsPtr;
|
||||
oldFullName = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(oldFullName);
|
||||
Tcl_GetCommandFullName(interp, cmd, oldFullName);
|
||||
|
||||
/*
|
||||
* Make sure that the destination command does not already exist. The
|
||||
* rename operation is like creating a command, so we should automatically
|
||||
@@ -3144,7 +3059,7 @@ Tcl_DeleteCommandFromToken(
|
||||
/*
|
||||
* We must delete this command, even though both traces and delete procs
|
||||
* may try to avoid this (renaming the command etc). Also traces and
|
||||
* delete procs may try to delete the command themselves. This flag
|
||||
* delete procs may try to delete the command themsevles. This flag
|
||||
* declares that a delete is in progress and that recursive deletes should
|
||||
* be ignored.
|
||||
*/
|
||||
@@ -3156,8 +3071,6 @@ Tcl_DeleteCommandFromToken(
|
||||
* traces.
|
||||
*/
|
||||
|
||||
cmdPtr->nsPtr->refCount++;
|
||||
|
||||
if (cmdPtr->tracePtr != NULL) {
|
||||
CommandTrace *tracePtr;
|
||||
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
|
||||
@@ -3185,7 +3098,6 @@ Tcl_DeleteCommandFromToken(
|
||||
*/
|
||||
|
||||
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
|
||||
TclNsDecrRefCount(cmdPtr->nsPtr);
|
||||
|
||||
/*
|
||||
* If the command being deleted has a compile function, increment the
|
||||
@@ -3523,7 +3435,6 @@ TclCleanupCommand(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
void
|
||||
Tcl_CreateMathFunc(
|
||||
Tcl_Interp *interp, /* Interpreter in which function is to be
|
||||
@@ -3574,7 +3485,7 @@ Tcl_CreateMathFunc(
|
||||
|
||||
static int
|
||||
OldMathFuncProc(
|
||||
ClientData clientData, /* Pointer to OldMathFuncData describing the
|
||||
ClientData clientData, /* Ponter to OldMathFuncData describing the
|
||||
* function being called */
|
||||
Tcl_Interp *interp, /* Tcl interpreter */
|
||||
int objc, /* Actual parameter count */
|
||||
@@ -3639,7 +3550,7 @@ OldMathFuncProc(
|
||||
args[k].type = TCL_INT;
|
||||
break;
|
||||
}
|
||||
if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
|
||||
if (Tcl_GetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
|
||||
== TCL_OK) {
|
||||
args[k].type = TCL_WIDE_INT;
|
||||
break;
|
||||
@@ -3665,7 +3576,7 @@ OldMathFuncProc(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
valuePtr = Tcl_GetObjResult(interp);
|
||||
TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
|
||||
Tcl_GetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
|
||||
Tcl_ResetResult(interp);
|
||||
break;
|
||||
}
|
||||
@@ -3687,7 +3598,7 @@ OldMathFuncProc(
|
||||
*/
|
||||
|
||||
if (funcResult.type == TCL_INT) {
|
||||
TclNewIntObj(valuePtr, funcResult.intValue);
|
||||
TclNewLongObj(valuePtr, funcResult.intValue);
|
||||
} else if (funcResult.type == TCL_WIDE_INT) {
|
||||
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
|
||||
} else {
|
||||
@@ -3855,7 +3766,6 @@ Tcl_ListMathFuncs(
|
||||
|
||||
return result;
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -4463,9 +4373,7 @@ TclNRRunCallbacks(
|
||||
/* All callbacks down to rootPtr not inclusive
|
||||
* are to be run. */
|
||||
{
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
NRE_callback *callbackPtr;
|
||||
Tcl_NRPostProc *procPtr;
|
||||
|
||||
@@ -4479,13 +4387,9 @@ TclNRRunCallbacks(
|
||||
* are for NR function calls, and those are Tcl_Obj based.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
if (*(iPtr->result) != 0) {
|
||||
(void) Tcl_GetObjResult(interp);
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
/* This is the trampoline. */
|
||||
|
||||
while (TOP_CB(interp) != rootPtr) {
|
||||
callbackPtr = TOP_CB(interp);
|
||||
@@ -4620,7 +4524,7 @@ TEOV_Exception(
|
||||
if (result == TCL_RETURN) {
|
||||
result = TclUpdateReturnInfo(iPtr);
|
||||
}
|
||||
if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
|
||||
if ((result != TCL_ERROR) && !allowExceptions) {
|
||||
ProcessUnexpectedResult(interp, result);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
@@ -4801,7 +4705,7 @@ TEOV_RunEnterTraces(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Command *cmdPtr = *cmdPtrPtr;
|
||||
unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
|
||||
int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
|
||||
int length, traceCode = TCL_OK;
|
||||
const char *command = TclGetStringFromObj(commandPtr, &length);
|
||||
|
||||
@@ -4944,7 +4848,6 @@ Tcl_EvalTokensStandard(
|
||||
NULL, NULL);
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -4992,7 +4895,6 @@ Tcl_EvalTokens(
|
||||
Tcl_ResetResult(interp);
|
||||
return resPtr;
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -5948,7 +5850,6 @@ TclArgumentGet(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
#undef Tcl_Eval
|
||||
int
|
||||
Tcl_Eval(
|
||||
@@ -6001,7 +5902,6 @@ Tcl_GlobalEvalObj(
|
||||
{
|
||||
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -6511,6 +6411,7 @@ Tcl_ExprLongObj(
|
||||
resultPtr = Tcl_NewBignumObj(&big);
|
||||
/* FALLTHROUGH */
|
||||
}
|
||||
case TCL_NUMBER_LONG:
|
||||
case TCL_NUMBER_WIDE:
|
||||
case TCL_NUMBER_BIG:
|
||||
result = TclGetLongFromObj(interp, resultPtr, ptr);
|
||||
@@ -6827,7 +6728,6 @@ Tcl_AppendObjToErrorInfo(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
#undef Tcl_AddErrorInfo
|
||||
void
|
||||
Tcl_AddErrorInfo(
|
||||
@@ -6837,7 +6737,6 @@ Tcl_AddErrorInfo(
|
||||
{
|
||||
Tcl_AddObjErrorInfo(interp, message, -1);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -6878,8 +6777,7 @@ Tcl_AddObjErrorInfo(
|
||||
|
||||
iPtr->flags |= ERR_LEGACY_COPY;
|
||||
if (iPtr->errorInfo == NULL) {
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
if (*(iPtr->result) != 0) {
|
||||
if (iPtr->result[0] != 0) {
|
||||
/*
|
||||
* The interp's string result is set, apparently by some extension
|
||||
* making a deprecated direct write to it. That extension may
|
||||
@@ -6889,9 +6787,9 @@ Tcl_AddObjErrorInfo(
|
||||
*/
|
||||
|
||||
iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
|
||||
} else
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
} else {
|
||||
iPtr->errorInfo = iPtr->objResultPtr;
|
||||
}
|
||||
Tcl_IncrRefCount(iPtr->errorInfo);
|
||||
if (!iPtr->errorCode) {
|
||||
Tcl_SetErrorCode(interp, "NONE", NULL);
|
||||
@@ -7011,7 +6909,6 @@ Tcl_VarEval(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
#undef Tcl_GlobalEval
|
||||
int
|
||||
Tcl_GlobalEval(
|
||||
@@ -7029,7 +6926,6 @@ Tcl_GlobalEval(
|
||||
iPtr->varFramePtr = savedVarFramePtr;
|
||||
return result;
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -7283,7 +7179,7 @@ ExprIsqrtFunc(
|
||||
}
|
||||
break;
|
||||
default:
|
||||
if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
|
||||
if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (w < 0) {
|
||||
@@ -7487,12 +7383,12 @@ ExprAbsFunc(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (type == TCL_NUMBER_WIDE) {
|
||||
Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
|
||||
if (type == TCL_NUMBER_LONG) {
|
||||
long l = *((const long *) ptr);
|
||||
|
||||
if (l > (Tcl_WideInt)0) {
|
||||
if (l > (long)0) {
|
||||
goto unChanged;
|
||||
} else if (l == (Tcl_WideInt)0) {
|
||||
} else if (l == (long)0) {
|
||||
const char *string = objv[1]->bytes;
|
||||
if (string) {
|
||||
while (*string != '0') {
|
||||
@@ -7504,11 +7400,11 @@ ExprAbsFunc(
|
||||
}
|
||||
}
|
||||
goto unChanged;
|
||||
} else if (l == LLONG_MIN) {
|
||||
TclInitBignumFromWideInt(&big, l);
|
||||
} else if (l == LONG_MIN) {
|
||||
TclBNInitBignumFromLong(&big, l);
|
||||
goto tooLarge;
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
|
||||
Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -7532,8 +7428,24 @@ ExprAbsFunc(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (type == TCL_NUMBER_WIDE) {
|
||||
Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
|
||||
|
||||
if (w >= (Tcl_WideInt)0) {
|
||||
goto unChanged;
|
||||
}
|
||||
if (w == LLONG_MIN) {
|
||||
TclBNInitBignumFromWideInt(&big, w);
|
||||
goto tooLarge;
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
if (type == TCL_NUMBER_BIG) {
|
||||
if (mp_isneg((const mp_int *) ptr)) {
|
||||
if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
|
||||
Tcl_GetBignumFromObj(NULL, objv[1], &big);
|
||||
tooLarge:
|
||||
mp_neg(&big, &big);
|
||||
@@ -7710,7 +7622,7 @@ ExprWideFunc(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
objPtr = Tcl_GetObjResult(interp);
|
||||
if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
|
||||
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
|
||||
/*
|
||||
* Truncate the bignum; keep only bits in wide int range.
|
||||
*/
|
||||
@@ -7721,78 +7633,13 @@ ExprWideFunc(
|
||||
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
|
||||
objPtr = Tcl_NewBignumObj(&big);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
TclGetWideIntFromObj(NULL, objPtr, &wResult);
|
||||
Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Common implmentation of max() and min().
|
||||
*/
|
||||
static int
|
||||
ExprMaxMinFunc(
|
||||
ClientData clientData, /* Ignored. */
|
||||
Tcl_Interp *interp, /* The interpreter in which to execute the
|
||||
* function. */
|
||||
int objc, /* Actual parameter count. */
|
||||
Tcl_Obj *const *objv, /* Actual parameter vector. */
|
||||
int op) /* Comparison direction */
|
||||
{
|
||||
Tcl_Obj *res;
|
||||
double d;
|
||||
int type, i;
|
||||
ClientData ptr;
|
||||
|
||||
if (objc < 2) {
|
||||
MathFuncWrongNumArgs(interp, 2, objc, objv);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
res = objv[1];
|
||||
for (i = 1; i < objc; i++) {
|
||||
if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (type == TCL_NUMBER_NAN) {
|
||||
/*
|
||||
* Get the error message for NaN.
|
||||
*/
|
||||
|
||||
Tcl_GetDoubleFromObj(interp, objv[i], &d);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (TclCompareTwoNumbers(objv[i], res) == op) {
|
||||
res = objv[i];
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, res);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
ExprMaxFunc(
|
||||
ClientData clientData, /* Ignored. */
|
||||
Tcl_Interp *interp, /* The interpreter in which to execute the
|
||||
* function. */
|
||||
int objc, /* Actual parameter count. */
|
||||
Tcl_Obj *const *objv) /* Actual parameter vector. */
|
||||
{
|
||||
return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
|
||||
}
|
||||
|
||||
static int
|
||||
ExprMinFunc(
|
||||
ClientData clientData, /* Ignored. */
|
||||
Tcl_Interp *interp, /* The interpreter in which to execute the
|
||||
* function. */
|
||||
int objc, /* Actual parameter count. */
|
||||
Tcl_Obj *const *objv) /* Actual parameter vector. */
|
||||
{
|
||||
return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
|
||||
}
|
||||
|
||||
static int
|
||||
ExprRandFunc(
|
||||
ClientData clientData, /* Ignored. */
|
||||
@@ -7816,8 +7663,8 @@ ExprRandFunc(
|
||||
iPtr->flags |= RAND_SEED_INITIALIZED;
|
||||
|
||||
/*
|
||||
* To ensure different seeds in different threads (bug #416643),
|
||||
* take into consideration the thread this interp is running in.
|
||||
* Take into consideration the thread this interp is running in order
|
||||
* to insure different seeds in different threads (bug #416643)
|
||||
*/
|
||||
|
||||
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
|
||||
@@ -8281,22 +8128,6 @@ Tcl_NRCreateCommand(
|
||||
cmdPtr->nreProc = nreProc;
|
||||
return (Tcl_Command) cmdPtr;
|
||||
}
|
||||
|
||||
Tcl_Command
|
||||
TclNRCreateCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
Tcl_ObjCmdProc *nreProc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc) {
|
||||
Command *cmdPtr = (Command *)
|
||||
TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
|
||||
|
||||
cmdPtr->nreProc = nreProc;
|
||||
return (Tcl_Command) cmdPtr;
|
||||
}
|
||||
|
||||
/****************************************************************************
|
||||
* Stuff for the public api
|
||||
@@ -8919,35 +8750,6 @@ TclNRCoroutineActivateCallback(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclNREvalList --
|
||||
*
|
||||
* Callback to invoke command as list, used in order to delayed
|
||||
* processing of canonical list command in sane environment.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
TclNREvalList(
|
||||
ClientData data[],
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
int objc;
|
||||
Tcl_Obj **objv;
|
||||
Tcl_Obj *listPtr = data[0];
|
||||
|
||||
Tcl_IncrRefCount(listPtr);
|
||||
|
||||
TclMarkTailcall(interp);
|
||||
TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
|
||||
TclListObjGetElements(NULL, listPtr, &objc, &objv);
|
||||
return TclNREvalObjv(interp, objc, objv, 0, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -9002,8 +8804,7 @@ NRCoroInjectObjCmd(
|
||||
*/
|
||||
|
||||
iPtr->execEnvPtr = corPtr->eePtr;
|
||||
TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
|
||||
NULL, NULL, NULL);
|
||||
TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
|
||||
iPtr->execEnvPtr = savedEEPtr;
|
||||
|
||||
return TCL_OK;
|
||||
@@ -9082,9 +8883,9 @@ TclNRCoroutineObjCmd(
|
||||
{
|
||||
Command *cmdPtr;
|
||||
CoroutineData *corPtr;
|
||||
const char *procName, *simpleName;
|
||||
Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
|
||||
*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
|
||||
const char *fullName, *procName;
|
||||
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
|
||||
Tcl_DString ds;
|
||||
Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
|
||||
|
||||
if (objc < 3) {
|
||||
@@ -9092,21 +8893,34 @@ TclNRCoroutineObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
procName = TclGetString(objv[1]);
|
||||
TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
|
||||
&nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
|
||||
/*
|
||||
* FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
|
||||
* something in tclUtil.c to find the FQ name.
|
||||
*/
|
||||
|
||||
fullName = TclGetString(objv[1]);
|
||||
TclGetNamespaceForQualName(interp, fullName, NULL, 0,
|
||||
&nsPtr, &altNsPtr, &cxtNsPtr, &procName);
|
||||
|
||||
if (nsPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"can't create procedure \"%s\": unknown namespace",
|
||||
procName));
|
||||
fullName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (simpleName == NULL) {
|
||||
if (procName == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"can't create procedure \"%s\": bad procedure name",
|
||||
procName));
|
||||
fullName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", fullName, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if ((nsPtr != iPtr->globalNsPtr)
|
||||
&& (procName != NULL) && (procName[0] == ':')) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"can't create procedure \"%s\" in non-global namespace with"
|
||||
" name starting with \":\"", procName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -9118,9 +8932,16 @@ TclNRCoroutineObjCmd(
|
||||
|
||||
corPtr = ckalloc(sizeof(CoroutineData));
|
||||
|
||||
cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
|
||||
(Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
|
||||
corPtr, DeleteCoroutine);
|
||||
Tcl_DStringInit(&ds);
|
||||
if (nsPtr != iPtr->globalNsPtr) {
|
||||
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
|
||||
TclDStringAppendLiteral(&ds, "::");
|
||||
}
|
||||
Tcl_DStringAppend(&ds, procName, -1);
|
||||
|
||||
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
|
||||
/*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine);
|
||||
Tcl_DStringFree(&ds);
|
||||
|
||||
corPtr->cmdPtr = cmdPtr;
|
||||
cmdPtr->refCount++;
|
||||
@@ -9181,7 +9002,7 @@ TclNRCoroutineObjCmd(
|
||||
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
|
||||
NULL, NULL, NULL);
|
||||
|
||||
/* ensure that the command is looked up in the correct namespace */
|
||||
/* insure that the command is looked up in the correct namespace */
|
||||
iPtr->lookupNsPtr = lookupNsPtr;
|
||||
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
|
||||
iPtr->numLevels--;
|
||||
|
||||
+8
-16
@@ -536,7 +536,7 @@ SetByteArrayFromAny(
|
||||
const char *src, *srcEnd;
|
||||
unsigned char *dst;
|
||||
ByteArray *byteArrayPtr;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
|
||||
if (objPtr->typePtr == &properByteArrayType) {
|
||||
return TCL_OK;
|
||||
@@ -551,7 +551,7 @@ SetByteArrayFromAny(
|
||||
|
||||
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
|
||||
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
src += Tcl_UtfToUniChar(src, &ch);
|
||||
improper = improper || (ch > 255);
|
||||
*dst++ = UCHAR(ch);
|
||||
}
|
||||
@@ -1300,10 +1300,10 @@ BinaryFormatCmd(
|
||||
|
||||
badField:
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
char buf[TCL_UTF_MAX + 1];
|
||||
|
||||
TclUtfToUniChar(errorString, &ch);
|
||||
Tcl_UtfToUniChar(errorString, &ch);
|
||||
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad field specifier \"%s\"", buf));
|
||||
@@ -1670,10 +1670,10 @@ BinaryScanCmd(
|
||||
|
||||
badField:
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
char buf[TCL_UTF_MAX + 1];
|
||||
|
||||
TclUtfToUniChar(errorString, &ch);
|
||||
Tcl_UtfToUniChar(errorString, &ch);
|
||||
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad field specifier \"%s\"", buf));
|
||||
@@ -1743,15 +1743,7 @@ GetFormatSpec(
|
||||
(*formatPtr)++;
|
||||
*countPtr = BINARY_ALL;
|
||||
} else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
|
||||
unsigned long int count;
|
||||
|
||||
errno = 0;
|
||||
count = strtoul(*formatPtr, (char **) formatPtr, 10);
|
||||
if (errno || (count > (unsigned long) INT_MAX)) {
|
||||
*countPtr = INT_MAX;
|
||||
} else {
|
||||
*countPtr = (int) count;
|
||||
}
|
||||
*countPtr = strtoul(*formatPtr, (char **) formatPtr, 10);
|
||||
} else {
|
||||
*countPtr = BINARY_NOCOUNT;
|
||||
}
|
||||
@@ -2284,7 +2276,7 @@ ScanNumber(
|
||||
Tcl_Obj *bigObj = NULL;
|
||||
mp_int big;
|
||||
|
||||
TclInitBignumFromWideUInt(&big, uwvalue);
|
||||
TclBNInitBignumFromWideUInt(&big, uwvalue);
|
||||
bigObj = Tcl_NewBignumObj(&big);
|
||||
return bigObj;
|
||||
}
|
||||
|
||||
+30
-33
@@ -89,14 +89,14 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
|
||||
#define BODY_OFFSET \
|
||||
((size_t) (&((struct mem_header *) 0)->body))
|
||||
|
||||
static unsigned int total_mallocs = 0;
|
||||
static unsigned int total_frees = 0;
|
||||
static int total_mallocs = 0;
|
||||
static int total_frees = 0;
|
||||
static size_t current_bytes_malloced = 0;
|
||||
static size_t maximum_bytes_malloced = 0;
|
||||
static unsigned int current_malloc_packets = 0;
|
||||
static unsigned int maximum_malloc_packets = 0;
|
||||
static unsigned int break_on_malloc = 0;
|
||||
static unsigned int trace_on_at_malloc = 0;
|
||||
static int current_malloc_packets = 0;
|
||||
static int maximum_malloc_packets = 0;
|
||||
static int break_on_malloc = 0;
|
||||
static int trace_on_at_malloc = 0;
|
||||
static int alloc_tracing = FALSE;
|
||||
static int init_malloced_bodies = TRUE;
|
||||
#ifdef MEM_VALIDATE
|
||||
@@ -184,18 +184,18 @@ TclDumpMemoryInfo(
|
||||
return 0;
|
||||
}
|
||||
sprintf(buf,
|
||||
"total mallocs %10u\n"
|
||||
"total frees %10u\n"
|
||||
"current packets allocated %10u\n"
|
||||
"current bytes allocated %10" TCL_Z_MODIFIER "u\n"
|
||||
"maximum packets allocated %10u\n"
|
||||
"maximum bytes allocated %10" TCL_Z_MODIFIER "u\n",
|
||||
"total mallocs %10d\n"
|
||||
"total frees %10d\n"
|
||||
"current packets allocated %10d\n"
|
||||
"current bytes allocated %10lu\n"
|
||||
"maximum packets allocated %10d\n"
|
||||
"maximum bytes allocated %10lu\n",
|
||||
total_mallocs,
|
||||
total_frees,
|
||||
current_malloc_packets,
|
||||
current_bytes_malloced,
|
||||
(unsigned long)current_bytes_malloced,
|
||||
maximum_malloc_packets,
|
||||
maximum_bytes_malloced);
|
||||
(unsigned long)maximum_bytes_malloced);
|
||||
if (flags == 0) {
|
||||
fprintf((FILE *)clientData, "%s", buf);
|
||||
} else {
|
||||
@@ -254,7 +254,7 @@ ValidateMemory(
|
||||
fprintf(stderr, "low guard failed at %p, %s %d\n",
|
||||
memHeaderP->body, file, line);
|
||||
fflush(stderr); /* In case name pointer is bad. */
|
||||
fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
|
||||
fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n", (Tcl_WideInt) memHeaderP->length,
|
||||
memHeaderP->file, memHeaderP->line);
|
||||
Tcl_Panic("Memory validation failure");
|
||||
}
|
||||
@@ -276,8 +276,8 @@ ValidateMemory(
|
||||
fprintf(stderr, "high guard failed at %p, %s %d\n",
|
||||
memHeaderP->body, file, line);
|
||||
fflush(stderr); /* In case name pointer is bad. */
|
||||
fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
|
||||
memHeaderP->length, memHeaderP->file,
|
||||
fprintf(stderr, "%" TCL_LL_MODIFIER "d bytes allocated at (%s %d)\n",
|
||||
(Tcl_WideInt)memHeaderP->length, memHeaderP->file,
|
||||
memHeaderP->line);
|
||||
Tcl_Panic("Memory validation failure");
|
||||
}
|
||||
@@ -359,9 +359,10 @@ Tcl_DumpActiveMemory(
|
||||
Tcl_MutexLock(ckallocMutexPtr);
|
||||
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
|
||||
address = &memScanP->body[0];
|
||||
fprintf(fileP, "%p - %p %" TCL_Z_MODIFIER "u @ %s %d %s",
|
||||
address, address + memScanP->length - 1,
|
||||
memScanP->length, memScanP->file, memScanP->line,
|
||||
fprintf(fileP, "%8" TCL_LL_MODIFIER "x - %8" TCL_LL_MODIFIER "x %7" TCL_LL_MODIFIER "d @ %s %d %s",
|
||||
(Tcl_WideInt)(size_t)address,
|
||||
(Tcl_WideInt)((size_t)address + memScanP->length - 1),
|
||||
(Tcl_WideInt)memScanP->length, memScanP->file, memScanP->line,
|
||||
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
|
||||
(void) fputc('\n', fileP);
|
||||
}
|
||||
@@ -449,7 +450,7 @@ Tcl_DbCkalloc(
|
||||
total_mallocs++;
|
||||
if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
|
||||
(void) fflush(stdout);
|
||||
fprintf(stderr, "reached malloc trace enable point (%u)\n",
|
||||
fprintf(stderr, "reached malloc trace enable point (%d)\n",
|
||||
total_mallocs);
|
||||
fflush(stderr);
|
||||
alloc_tracing = TRUE;
|
||||
@@ -464,7 +465,7 @@ Tcl_DbCkalloc(
|
||||
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
|
||||
break_on_malloc = 0;
|
||||
(void) fflush(stdout);
|
||||
Tcl_Panic("reached malloc break limit (%u)", total_mallocs);
|
||||
Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
|
||||
}
|
||||
|
||||
current_malloc_packets++;
|
||||
@@ -611,8 +612,8 @@ Tcl_DbCkfree(
|
||||
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
|
||||
|
||||
if (alloc_tracing) {
|
||||
fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
|
||||
memp->body, memp->length, file, line);
|
||||
fprintf(stderr, "ckfree %p %" TCL_LL_MODIFIER "d %s %d\n",
|
||||
memp->body, (Tcl_WideInt) memp->length, file, line);
|
||||
}
|
||||
|
||||
if (validate_memory) {
|
||||
@@ -847,24 +848,22 @@ MemoryCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
if (strcmp(argv[1],"break_on_malloc") == 0) {
|
||||
int value;
|
||||
if (argc != 3) {
|
||||
goto argError;
|
||||
}
|
||||
if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
|
||||
if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break_on_malloc = (unsigned int) value;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (strcmp(argv[1],"info") == 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
|
||||
"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
|
||||
"total mallocs", total_mallocs, "total frees", total_frees,
|
||||
"current packets allocated", current_malloc_packets,
|
||||
"current bytes allocated", current_bytes_malloced,
|
||||
"current bytes allocated", (unsigned long)current_bytes_malloced,
|
||||
"maximum packets allocated", maximum_malloc_packets,
|
||||
"maximum bytes allocated", maximum_bytes_malloced));
|
||||
"maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
|
||||
return TCL_OK;
|
||||
}
|
||||
if (strcmp(argv[1], "init") == 0) {
|
||||
@@ -935,14 +934,12 @@ MemoryCmd(
|
||||
}
|
||||
|
||||
if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
|
||||
int value;
|
||||
if (argc != 3) {
|
||||
goto argError;
|
||||
}
|
||||
if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
|
||||
if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
trace_on_at_malloc = value;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (strcmp(argv[1],"validate") == 0) {
|
||||
|
||||
+17
-29
@@ -91,7 +91,7 @@ static const char *const literals[] = {
|
||||
* Structure containing the client data for [clock]
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ClockClientData {
|
||||
size_t refCount; /* Number of live references. */
|
||||
Tcl_Obj **literals; /* Pool of object literals. */
|
||||
} ClockClientData;
|
||||
@@ -208,7 +208,11 @@ struct ClockCommand {
|
||||
};
|
||||
|
||||
static const struct ClockCommand clockCommands[] = {
|
||||
{ "clicks", ClockClicksObjCmd },
|
||||
{ "getenv", ClockGetenvObjCmd },
|
||||
{ "microseconds", ClockMicrosecondsObjCmd },
|
||||
{ "milliseconds", ClockMillisecondsObjCmd },
|
||||
{ "seconds", ClockSecondsObjCmd },
|
||||
{ "Oldscan", TclClockOldscanObjCmd },
|
||||
{ "ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd },
|
||||
{ "GetDateFields", ClockGetdatefieldsObjCmd },
|
||||
@@ -249,19 +253,6 @@ TclClockInit(
|
||||
ClockClientData *data;
|
||||
int i;
|
||||
|
||||
/* Structure of the 'clock' ensemble */
|
||||
|
||||
static const EnsembleImplMap clockImplMap[] = {
|
||||
{"add", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
|
||||
{"clicks", ClockClicksObjCmd, TclCompileClockClicksCmd, NULL, NULL, 0},
|
||||
{"format", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
|
||||
{"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0},
|
||||
{"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0},
|
||||
{"scan", NULL, TclCompileBasicMin1ArgCmd, NULL, NULL , 0},
|
||||
{"seconds", ClockSecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(3), 0},
|
||||
{NULL, NULL, NULL, NULL, NULL, 0}
|
||||
};
|
||||
|
||||
/*
|
||||
* Safe interps get [::clock] as alias to a master, so do not need their
|
||||
* own copies of the support routines.
|
||||
@@ -285,7 +276,6 @@ TclClockInit(
|
||||
|
||||
/*
|
||||
* Install the commands.
|
||||
* TODO - Let Tcl_MakeEnsemble do this?
|
||||
*/
|
||||
|
||||
#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
|
||||
@@ -296,10 +286,6 @@ TclClockInit(
|
||||
Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
|
||||
ClockDeleteCmdProc);
|
||||
}
|
||||
|
||||
/* Make the clock ensemble */
|
||||
|
||||
TclMakeEnsemble(interp, "clock", clockImplMap);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -363,7 +349,7 @@ ClockConvertlocaltoutcObjCmd(
|
||||
"found in dictionary", -1));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if ((TclGetWideIntFromObj(interp, secondsObj,
|
||||
if ((Tcl_GetWideIntFromObj(interp, secondsObj,
|
||||
&fields.localSeconds) != TCL_OK)
|
||||
|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
|
||||
|| ConvertLocalToUTC(interp, &fields, objv[2], changeover)) {
|
||||
@@ -442,7 +428,7 @@ ClockGetdatefieldsObjCmd(
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
|
||||
if (Tcl_GetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
|
||||
|| TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1148,7 +1134,7 @@ LookupLastTransition(
|
||||
*/
|
||||
|
||||
if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
|
||||
|| TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
|
||||
|| Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
@@ -1171,7 +1157,7 @@ LookupLastTransition(
|
||||
int m = (l + u + 1) / 2;
|
||||
|
||||
if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
|
||||
TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
|
||||
Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
if (tick >= compVal) {
|
||||
@@ -1521,9 +1507,9 @@ GetJulianDayFromEraYearMonthDay(
|
||||
* See above bug for details. The casts are necessary.
|
||||
*/
|
||||
if (ym1 >= 0)
|
||||
ym1o4 = ym1 / 4;
|
||||
ym1o4 = ym1 / 4;
|
||||
else {
|
||||
ym1o4 = - (int) (((unsigned int) -ym1) / 4);
|
||||
ym1o4 = - (int) (((unsigned int) -ym1) / 4);
|
||||
}
|
||||
#endif
|
||||
if (ym1 % 4 < 0) {
|
||||
@@ -1578,10 +1564,12 @@ static int
|
||||
IsGregorianLeapYear(
|
||||
TclDateFields *fields) /* Date to test */
|
||||
{
|
||||
int year = fields->year;
|
||||
int year;
|
||||
|
||||
if (fields->era == BCE) {
|
||||
year = 1 - year;
|
||||
year = 1 - fields->year;
|
||||
} else {
|
||||
year = fields->year;
|
||||
}
|
||||
if (year%4 != 0) {
|
||||
return 0;
|
||||
@@ -1692,7 +1680,7 @@ ThreadSafeLocalTime(
|
||||
* Get a thread-local buffer to hold the returned time.
|
||||
*/
|
||||
|
||||
struct tm *tmPtr = Tcl_GetThreadData(&tmKey, sizeof(struct tm));
|
||||
struct tm *tmPtr = Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
|
||||
#ifdef HAVE_LOCALTIME_R
|
||||
localtime_r(timePtr, tmPtr);
|
||||
#else
|
||||
@@ -1948,7 +1936,7 @@ ClockParseformatargsObjCmd(
|
||||
* Check options.
|
||||
*/
|
||||
|
||||
if (TclGetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
|
||||
if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if ((saw & (1 << CLOCK_FORMAT_GMT))
|
||||
|
||||
+69
-347
@@ -46,24 +46,9 @@ struct ForeachState {
|
||||
|
||||
static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
int mode);
|
||||
static int BadEncodingSubcommand(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int EncodingConvertfromObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int EncodingConverttoObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int EncodingDirsObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int EncodingNamesObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int EncodingSystemObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static inline int ForeachAssignments(Tcl_Interp *interp,
|
||||
struct ForeachState *statePtr);
|
||||
static inline void ForeachCleanup(Tcl_Interp *interp,
|
||||
@@ -164,7 +149,7 @@ Tcl_BreakObjCmd(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Tcl_CaseObjCmd(
|
||||
@@ -557,280 +542,79 @@ Tcl_EncodingObjCmd(
|
||||
|
||||
switch ((enum options) index) {
|
||||
case ENC_CONVERTTO:
|
||||
return EncodingConverttoObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_CONVERTFROM:
|
||||
return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_CONVERTFROM: {
|
||||
Tcl_Obj *data;
|
||||
Tcl_DString ds;
|
||||
Tcl_Encoding encoding;
|
||||
int length;
|
||||
const char *stringPtr;
|
||||
|
||||
if (objc == 3) {
|
||||
encoding = Tcl_GetEncoding(interp, NULL);
|
||||
data = objv[2];
|
||||
} else if (objc == 4) {
|
||||
if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
data = objv[3];
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if ((enum options) index == ENC_CONVERTFROM) {
|
||||
/*
|
||||
* Treat the string as binary data.
|
||||
*/
|
||||
|
||||
stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
|
||||
Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);
|
||||
|
||||
/*
|
||||
* Note that we cannot use Tcl_DStringResult here because it will
|
||||
* truncate the string at the first null byte.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, TclDStringToObj(&ds));
|
||||
} else {
|
||||
/*
|
||||
* Store the result as binary data.
|
||||
*/
|
||||
|
||||
stringPtr = TclGetStringFromObj(data, &length);
|
||||
Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
|
||||
(unsigned char *) Tcl_DStringValue(&ds),
|
||||
Tcl_DStringLength(&ds)));
|
||||
Tcl_DStringFree(&ds);
|
||||
}
|
||||
|
||||
Tcl_FreeEncoding(encoding);
|
||||
break;
|
||||
}
|
||||
case ENC_DIRS:
|
||||
return EncodingDirsObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_NAMES:
|
||||
return EncodingNamesObjCmd(dummy, interp, objc, objv);
|
||||
if (objc > 2) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_GetEncodingNames(interp);
|
||||
break;
|
||||
case ENC_SYSTEM:
|
||||
return EncodingSystemObjCmd(dummy, interp, objc, objv);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* TclInitEncodingCmd --
|
||||
*
|
||||
* This function creates the 'encoding' ensemble.
|
||||
*
|
||||
* Results:
|
||||
* Returns the Tcl_Command so created.
|
||||
*
|
||||
* Side effects:
|
||||
* The ensemble is initialized.
|
||||
*
|
||||
* This command is hidden in a safe interpreter.
|
||||
*/
|
||||
|
||||
Tcl_Command
|
||||
TclInitEncodingCmd(
|
||||
Tcl_Interp* interp) /* Tcl interpreter */
|
||||
{
|
||||
static const EnsembleImplMap encodingImplMap[] = {
|
||||
{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"convertto", EncodingConverttoObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
|
||||
{"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
|
||||
{"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
|
||||
{NULL, NULL, NULL, NULL, NULL, 0}
|
||||
};
|
||||
|
||||
return TclMakeEnsemble(interp, "encoding", encodingImplMap);
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* TclMakeEncodingCommandSafe --
|
||||
*
|
||||
* This function hides the unsafe 'dirs' and 'system' subcommands of
|
||||
* the "encoding" Tcl command ensemble. It must be called only from
|
||||
* TclHideUnsafeCommands.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result
|
||||
*
|
||||
* Side effects:
|
||||
* Adds commands to the table of hidden commands.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclMakeEncodingCommandSafe(
|
||||
Tcl_Interp* interp) /* Tcl interpreter */
|
||||
{
|
||||
static const struct {
|
||||
const char *cmdName;
|
||||
int unsafe;
|
||||
} unsafeInfo[] = {
|
||||
{"convertfrom", 0},
|
||||
{"convertto", 0},
|
||||
{"dirs", 1},
|
||||
{"names", 0},
|
||||
{"system", 0},
|
||||
{NULL, 0}
|
||||
};
|
||||
|
||||
int i;
|
||||
Tcl_DString oldBuf, newBuf;
|
||||
|
||||
Tcl_DStringInit(&oldBuf);
|
||||
TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
|
||||
Tcl_DStringInit(&newBuf);
|
||||
TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
|
||||
for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
|
||||
if (unsafeInfo[i].unsafe) {
|
||||
const char *oldName, *newName;
|
||||
|
||||
Tcl_DStringSetLength(&oldBuf, 17);
|
||||
oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
|
||||
Tcl_DStringSetLength(&newBuf, 13);
|
||||
newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
|
||||
if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
|
||||
|| Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
|
||||
Tcl_Panic("problem making 'encoding %s' safe: %s",
|
||||
unsafeInfo[i].cmdName,
|
||||
Tcl_GetString(Tcl_GetObjResult(interp)));
|
||||
}
|
||||
Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
|
||||
(ClientData) unsafeInfo[i].cmdName, NULL);
|
||||
}
|
||||
}
|
||||
Tcl_DStringFree(&oldBuf);
|
||||
Tcl_DStringFree(&newBuf);
|
||||
|
||||
/*
|
||||
* Ugh. The [encoding] command is now actually safe, but it is assumed by
|
||||
* scripts that it is not, which messes up security policies.
|
||||
*/
|
||||
|
||||
if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
|
||||
Tcl_Panic("problem making 'encoding' safe: %s",
|
||||
Tcl_GetString(Tcl_GetObjResult(interp)));
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* BadEncodingSubcommand --
|
||||
*
|
||||
* Command used to act as a backstop implementation when subcommands of
|
||||
* "encoding" are unsafe (the real implementations of the subcommands are
|
||||
* hidden). The clientData is always the full official subcommand name.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result (always a TCL_ERROR).
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
BadEncodingSubcommand(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
const char *subcommandName = (const char *) clientData;
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"not allowed to invoke subcommand %s of encoding", subcommandName));
|
||||
Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* EncodingConvertfromObjCmd --
|
||||
*
|
||||
* This command converts a byte array in an external encoding into a
|
||||
* Tcl string
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
EncodingConvertfromObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_Obj *data; /* Byte array to convert */
|
||||
Tcl_DString ds; /* Buffer to hold the string */
|
||||
Tcl_Encoding encoding; /* Encoding to use */
|
||||
int length; /* Length of the byte array being converted */
|
||||
const char *bytesPtr; /* Pointer to the first byte of the array */
|
||||
|
||||
if (objc == 2) {
|
||||
encoding = Tcl_GetEncoding(interp, NULL);
|
||||
data = objv[1];
|
||||
} else if (objc == 3) {
|
||||
if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
|
||||
if (objc > 3) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
data = objv[2];
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert the string into a byte array in 'ds'
|
||||
*/
|
||||
bytesPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
|
||||
Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);
|
||||
|
||||
/*
|
||||
* Note that we cannot use Tcl_DStringResult here because it will
|
||||
* truncate the string at the first null byte.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, TclDStringToObj(&ds));
|
||||
|
||||
/*
|
||||
* We're done with the encoding
|
||||
*/
|
||||
|
||||
Tcl_FreeEncoding(encoding);
|
||||
return TCL_OK;
|
||||
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* EncodingConverttoObjCmd --
|
||||
*
|
||||
* This command converts a Tcl string into a byte array that
|
||||
* encodes the string according to some encoding.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
EncodingConverttoObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_Obj *data; /* String to convert */
|
||||
Tcl_DString ds; /* Buffer to hold the byte array */
|
||||
Tcl_Encoding encoding; /* Encoding to use */
|
||||
int length; /* Length of the string being converted */
|
||||
const char *stringPtr; /* Pointer to the first byte of the string */
|
||||
|
||||
/* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */
|
||||
|
||||
if (objc == 2) {
|
||||
encoding = Tcl_GetEncoding(interp, NULL);
|
||||
data = objv[1];
|
||||
} else if (objc == 3) {
|
||||
if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
if (objc == 2) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
Tcl_GetEncodingName(NULL), -1));
|
||||
} else {
|
||||
return Tcl_SetSystemEncoding(interp, TclGetString(objv[2]));
|
||||
}
|
||||
data = objv[2];
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
|
||||
return TCL_ERROR;
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert the string to a byte array in 'ds'
|
||||
*/
|
||||
|
||||
stringPtr = TclGetStringFromObj(data, &length);
|
||||
Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
|
||||
Tcl_DStringLength(&ds)));
|
||||
Tcl_DStringFree(&ds);
|
||||
|
||||
/*
|
||||
* We're done with the encoding
|
||||
*/
|
||||
|
||||
Tcl_FreeEncoding(encoding);
|
||||
return TCL_OK;
|
||||
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -858,16 +642,16 @@ EncodingDirsObjCmd(
|
||||
{
|
||||
Tcl_Obj *dirListObj;
|
||||
|
||||
if (objc > 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
|
||||
if (objc > 3) {
|
||||
Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 1) {
|
||||
if (objc == 2) {
|
||||
Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
dirListObj = objv[1];
|
||||
dirListObj = objv[2];
|
||||
if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected directory list but got \"%s\"",
|
||||
@@ -880,68 +664,6 @@ EncodingDirsObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* EncodingNamesObjCmd --
|
||||
*
|
||||
* This command returns a list of the available encoding names
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl result
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
EncodingNamesObjCmd(ClientData dummy, /* Unused */
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
int objc, /* Number of command line args */
|
||||
Tcl_Obj* const objv[]) /* Vector of command line args */
|
||||
{
|
||||
if (objc > 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_GetEncodingNames(interp);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* EncodingSystemObjCmd --
|
||||
*
|
||||
* This command retrieves or changes the system encoding
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl result
|
||||
*
|
||||
* Side effects:
|
||||
* May change the system encoding.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
EncodingSystemObjCmd(ClientData dummy, /* Unused */
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
int objc, /* Number of command line args */
|
||||
Tcl_Obj* const objv[]) /* Vector of command line args */
|
||||
{
|
||||
if (objc > 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 1) {
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1));
|
||||
} else {
|
||||
return Tcl_SetSystemEncoding(interp, TclGetString(objv[1]));
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+157
-209
@@ -64,9 +64,8 @@ typedef struct SortInfo {
|
||||
* SORTMODE_COMMAND. Pre-initialized to hold
|
||||
* base of command. */
|
||||
int *indexv; /* If the -index option was specified, this
|
||||
* holds an encoding of the indexes contained
|
||||
* in the list supplied as an argument to
|
||||
* that option.
|
||||
* holds the indexes contained in the list
|
||||
* supplied as an argument to that option.
|
||||
* NULL if no indexes supplied, and points to
|
||||
* singleIndex field when only one
|
||||
* supplied. */
|
||||
@@ -93,6 +92,14 @@ typedef struct SortInfo {
|
||||
#define SORTMODE_DICTIONARY 4
|
||||
#define SORTMODE_ASCII_NC 8
|
||||
|
||||
/*
|
||||
* Magic values for the index field of the SortInfo structure. Note that the
|
||||
* index "end-1" will be translated to SORTIDX_END-1, etc.
|
||||
*/
|
||||
|
||||
#define SORTIDX_NONE -1 /* Not indexed; use whole value. */
|
||||
#define SORTIDX_END -2 /* Indexed from end. */
|
||||
|
||||
/*
|
||||
* Forward declarations for procedures defined in this file:
|
||||
*/
|
||||
@@ -2153,7 +2160,7 @@ Tcl_JoinObjCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||||
{
|
||||
int length, listLen;
|
||||
int listLen;
|
||||
Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
|
||||
|
||||
if ((objc < 2) || (objc > 3)) {
|
||||
@@ -2184,9 +2191,9 @@ Tcl_JoinObjCmd(
|
||||
joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
|
||||
Tcl_IncrRefCount(joinObjPtr);
|
||||
|
||||
(void) Tcl_GetStringFromObj(joinObjPtr, &length);
|
||||
if (length == 0) {
|
||||
resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
|
||||
if (Tcl_GetCharLength(joinObjPtr) == 0) {
|
||||
TclStringCatObjv(interp, /* inPlace */ 0, listLen, elemPtrs,
|
||||
&resObjPtr);
|
||||
} else {
|
||||
int i;
|
||||
|
||||
@@ -2536,6 +2543,7 @@ Tcl_LrangeObjCmd(
|
||||
register Tcl_Obj *const objv[])
|
||||
/* Argument objects. */
|
||||
{
|
||||
Tcl_Obj **elemPtrs;
|
||||
int listLen, first, last, result;
|
||||
|
||||
if (objc != 4) {
|
||||
@@ -2553,14 +2561,55 @@ Tcl_LrangeObjCmd(
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
|
||||
result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
|
||||
&last);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
if (last >= listLen) {
|
||||
last = listLen - 1;
|
||||
}
|
||||
|
||||
if (first > last) {
|
||||
/*
|
||||
* Returning an empty list is easy.
|
||||
*/
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
if (Tcl_IsShared(objv[1]) ||
|
||||
((ListRepPtr(objv[1])->refCount > 1))) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
|
||||
&elemPtrs[first]));
|
||||
} else {
|
||||
/*
|
||||
* In-place is possible.
|
||||
*/
|
||||
|
||||
if (last < (listLen - 1)) {
|
||||
Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
|
||||
0, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
* This one is not conditioned on (first > 0) in order to preserve the
|
||||
* string-canonizing effect of [lrange 0 end].
|
||||
*/
|
||||
|
||||
Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2738,7 +2787,7 @@ Tcl_LreplaceObjCmd(
|
||||
* (to allow for replacing the last elem).
|
||||
*/
|
||||
|
||||
if ((first >= listLen) && (listLen > 0)) {
|
||||
if ((first > listLen) && (listLen > 0)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %s", TclGetString(objv[2])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
|
||||
@@ -2889,21 +2938,20 @@ Tcl_LsearchObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument values. */
|
||||
{
|
||||
const char *bytes, *patternBytes;
|
||||
int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
|
||||
int allocatedIndexVector = 0;
|
||||
int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
|
||||
int i, match, index, result, listc, length, elemLen, bisect;
|
||||
int dataType, isIncreasing, lower, upper, offset;
|
||||
Tcl_WideInt patWide, objWide;
|
||||
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
|
||||
double patDouble, objDouble;
|
||||
SortInfo sortInfo;
|
||||
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
|
||||
SortStrCmpFn_t strCmpFn = TclUtfCmp;
|
||||
SortStrCmpFn_t strCmpFn = strcmp;
|
||||
Tcl_RegExp regexp = NULL;
|
||||
static const char *const options[] = {
|
||||
"-all", "-ascii", "-bisect", "-decreasing", "-dictionary",
|
||||
"-exact", "-glob", "-increasing", "-index",
|
||||
"-inline", "-integer", "-nocase", "-not",
|
||||
"-real", "-regexp", "-sorted", "-start", "-stride",
|
||||
"-real", "-regexp", "-sorted", "-start",
|
||||
"-subindices", NULL
|
||||
};
|
||||
enum options {
|
||||
@@ -2911,7 +2959,7 @@ Tcl_LsearchObjCmd(
|
||||
LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
|
||||
LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
|
||||
LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
|
||||
LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES
|
||||
LSEARCH_START, LSEARCH_SUBINDICES
|
||||
};
|
||||
enum datatypes {
|
||||
ASCII, DICTIONARY, INTEGER, REAL
|
||||
@@ -2931,9 +2979,7 @@ Tcl_LsearchObjCmd(
|
||||
bisect = 0;
|
||||
listPtr = NULL;
|
||||
startPtr = NULL;
|
||||
groupSize = 1;
|
||||
groupOffset = 0;
|
||||
start = 0;
|
||||
offset = 0;
|
||||
noCase = 0;
|
||||
sortInfo.compareCmdPtr = NULL;
|
||||
sortInfo.isIncreasing = 1;
|
||||
@@ -2951,6 +2997,9 @@ Tcl_LsearchObjCmd(
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
|
||||
!= TCL_OK) {
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
@@ -3015,7 +3064,6 @@ Tcl_LsearchObjCmd(
|
||||
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
startPtr = NULL;
|
||||
}
|
||||
if (i > objc-4) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
@@ -3036,47 +3084,25 @@ Tcl_LsearchObjCmd(
|
||||
startPtr = Tcl_DuplicateObj(objv[i]);
|
||||
} else {
|
||||
startPtr = objv[i];
|
||||
Tcl_IncrRefCount(startPtr);
|
||||
}
|
||||
Tcl_IncrRefCount(startPtr);
|
||||
break;
|
||||
case LSEARCH_STRIDE: /* -stride */
|
||||
if (i > objc-4) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"\"-stride\" option must be "
|
||||
"followed by stride length", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
if (groupSize < 1) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"stride length must be at least 1", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
|
||||
"BADSTRIDE", NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
i++;
|
||||
break;
|
||||
case LSEARCH_INDEX: { /* -index */
|
||||
Tcl_Obj **indices;
|
||||
int j;
|
||||
|
||||
if (allocatedIndexVector) {
|
||||
if (sortInfo.indexc > 1) {
|
||||
TclStackFree(interp, sortInfo.indexv);
|
||||
allocatedIndexVector = 0;
|
||||
}
|
||||
if (i > objc-4) {
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"\"-index\" option must be followed by list index",
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3088,8 +3114,10 @@ Tcl_LsearchObjCmd(
|
||||
i++;
|
||||
if (TclListObjGetElements(interp, objv[i],
|
||||
&sortInfo.indexc, &indices) != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
switch (sortInfo.indexc) {
|
||||
case 0:
|
||||
@@ -3101,8 +3129,6 @@ Tcl_LsearchObjCmd(
|
||||
default:
|
||||
sortInfo.indexv =
|
||||
TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
|
||||
allocatedIndexVector = 1; /* Cannot use indexc field, as it
|
||||
* might be decreased by 1 later. */
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3112,26 +3138,13 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
int encoded = 0;
|
||||
if (TclIndexEncode(interp, indices[j], TCL_INDEX_BEFORE,
|
||||
TCL_INDEX_AFTER, &encoded) != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
if ((encoded == TCL_INDEX_BEFORE)
|
||||
|| (encoded == TCL_INDEX_AFTER)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"index \"%s\" cannot select an element "
|
||||
"from any list", Tcl_GetString(indices[j])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
|
||||
"OUTOFRANGE", NULL);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
if (result == TCL_ERROR) {
|
||||
if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
|
||||
&sortInfo.indexv[j]) != TCL_OK) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (-index option item number %d)", j));
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
sortInfo.indexv[j] = encoded;
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -3143,12 +3156,14 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
if (returnSubindices && sortInfo.indexc==0) {
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"-subindices cannot be used without -index option", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
|
||||
"BAD_OPTION_MIX", NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (bisect && (allMatches || negatedMatch)) {
|
||||
@@ -3156,8 +3171,7 @@ Tcl_LsearchObjCmd(
|
||||
"-bisect is not compatible with -all or -not", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
|
||||
"BAD_OPTION_MIX", NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (mode == REGEXP) {
|
||||
@@ -3183,6 +3197,9 @@ Tcl_LsearchObjCmd(
|
||||
}
|
||||
|
||||
if (regexp == NULL) {
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
@@ -3195,64 +3212,24 @@ Tcl_LsearchObjCmd(
|
||||
|
||||
result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
|
||||
if (result != TCL_OK) {
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
goto done;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for sanity when grouping elements of the overall list together
|
||||
* because of the -stride option. [TIP #351]
|
||||
*/
|
||||
|
||||
if (groupSize > 1) {
|
||||
if (listc % groupSize) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"list size must be a multiple of the stride length",
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE",
|
||||
NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
if (sortInfo.indexc > 0) {
|
||||
/*
|
||||
* Use the first value in the list supplied to -index as the
|
||||
* offset of the element within each group by which to sort.
|
||||
*/
|
||||
|
||||
groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
|
||||
if (groupOffset < 0 || groupOffset >= groupSize) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"when used with \"-stride\", the leading \"-index\""
|
||||
" value must be within the group", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
|
||||
"BADINDEX", NULL);
|
||||
result = TCL_ERROR;
|
||||
goto done;
|
||||
}
|
||||
if (sortInfo.indexc == 1) {
|
||||
sortInfo.indexc = 0;
|
||||
sortInfo.indexv = NULL;
|
||||
} else {
|
||||
sortInfo.indexc--;
|
||||
|
||||
for (i = 0; i < sortInfo.indexc; i++) {
|
||||
sortInfo.indexv[i] = sortInfo.indexv[i+1];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the user-specified start offset.
|
||||
*/
|
||||
|
||||
if (startPtr) {
|
||||
result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
|
||||
result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
if (result != TCL_OK) {
|
||||
goto done;
|
||||
}
|
||||
if (start < 0) {
|
||||
start = 0;
|
||||
if (offset < 0) {
|
||||
offset = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3260,21 +3237,16 @@ Tcl_LsearchObjCmd(
|
||||
* "did not match anything at all" result straight away. [Bug 1374778]
|
||||
*/
|
||||
|
||||
if (start > listc-1) {
|
||||
if (offset > listc-1) {
|
||||
if (sortInfo.indexc > 1) {
|
||||
TclStackFree(interp, sortInfo.indexv);
|
||||
}
|
||||
if (allMatches || inlineReturn) {
|
||||
Tcl_ResetResult(interp);
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
|
||||
}
|
||||
goto done;
|
||||
}
|
||||
|
||||
/*
|
||||
* If start points within a group, it points to the start of the group.
|
||||
*/
|
||||
|
||||
if (groupSize > 1) {
|
||||
start -= (start % groupSize);
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3333,23 +3305,18 @@ Tcl_LsearchObjCmd(
|
||||
* sense in doing this when the match sense is inverted.
|
||||
*/
|
||||
|
||||
/*
|
||||
* With -stride, lower, upper and i are kept as multiples of groupSize.
|
||||
*/
|
||||
|
||||
lower = start - groupSize;
|
||||
lower = offset - 1;
|
||||
upper = listc;
|
||||
while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
|
||||
while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
|
||||
i = (lower + upper)/2;
|
||||
i -= i % groupSize;
|
||||
if (sortInfo.indexc != 0) {
|
||||
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
|
||||
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
|
||||
if (sortInfo.resultCode != TCL_OK) {
|
||||
result = sortInfo.resultCode;
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
itemPtr = listv[i+groupOffset];
|
||||
itemPtr = listv[i];
|
||||
}
|
||||
switch ((enum datatypes) dataType) {
|
||||
case ASCII:
|
||||
@@ -3438,10 +3405,10 @@ Tcl_LsearchObjCmd(
|
||||
if (allMatches) {
|
||||
listPtr = Tcl_NewListObj(0, NULL);
|
||||
}
|
||||
for (i = start; i < listc; i += groupSize) {
|
||||
for (i = offset; i < listc; i++) {
|
||||
match = 0;
|
||||
if (sortInfo.indexc != 0) {
|
||||
itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
|
||||
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
|
||||
if (sortInfo.resultCode != TCL_OK) {
|
||||
if (listPtr != NULL) {
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
@@ -3450,7 +3417,7 @@ Tcl_LsearchObjCmd(
|
||||
goto done;
|
||||
}
|
||||
} else {
|
||||
itemPtr = listv[i+groupOffset];
|
||||
itemPtr = listv[i];
|
||||
}
|
||||
|
||||
switch (mode) {
|
||||
@@ -3540,23 +3507,18 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
if (returnSubindices && (sortInfo.indexc != 0)) {
|
||||
itemPtr = SelectObjFromSublist(listv[i+groupOffset],
|
||||
&sortInfo);
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
} else if (groupSize > 1) {
|
||||
Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
|
||||
groupSize, &listv[i]);
|
||||
itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
|
||||
} else {
|
||||
itemPtr = listv[i];
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
} else if (returnSubindices) {
|
||||
int j;
|
||||
|
||||
itemPtr = Tcl_NewIntObj(i+groupOffset);
|
||||
itemPtr = Tcl_NewIntObj(i);
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
|
||||
TclIndexDecode(sortInfo.indexv[j], listc)));
|
||||
Tcl_ListObjAppendElement(interp, itemPtr,
|
||||
Tcl_NewIntObj(sortInfo.indexv[j]));
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
|
||||
} else {
|
||||
@@ -3575,10 +3537,10 @@ Tcl_LsearchObjCmd(
|
||||
if (returnSubindices) {
|
||||
int j;
|
||||
|
||||
itemPtr = Tcl_NewIntObj(index+groupOffset);
|
||||
itemPtr = Tcl_NewIntObj(index);
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
|
||||
TclIndexDecode(sortInfo.indexv[j], listc)));
|
||||
Tcl_ListObjAppendElement(interp, itemPtr,
|
||||
Tcl_NewIntObj(sortInfo.indexv[j]));
|
||||
}
|
||||
Tcl_SetObjResult(interp, itemPtr);
|
||||
} else {
|
||||
@@ -3592,14 +3554,7 @@ Tcl_LsearchObjCmd(
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewObj());
|
||||
} else {
|
||||
if (returnSubindices) {
|
||||
Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
|
||||
&sortInfo));
|
||||
} else if (groupSize > 1) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, listv[index]);
|
||||
}
|
||||
Tcl_SetObjResult(interp, listv[index]);
|
||||
}
|
||||
result = TCL_OK;
|
||||
|
||||
@@ -3608,10 +3563,7 @@ Tcl_LsearchObjCmd(
|
||||
*/
|
||||
|
||||
done:
|
||||
if (startPtr != NULL) {
|
||||
Tcl_DecrRefCount(startPtr);
|
||||
}
|
||||
if (allocatedIndexVector) {
|
||||
if (sortInfo.indexc > 1) {
|
||||
TclStackFree(interp, sortInfo.indexv);
|
||||
}
|
||||
return result;
|
||||
@@ -3730,7 +3682,7 @@ Tcl_LsortObjCmd(
|
||||
int sortMode = SORTMODE_ASCII;
|
||||
int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
|
||||
Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
|
||||
SortElement *elementArray = NULL, *elementPtr;
|
||||
SortElement *elementArray, *elementPtr;
|
||||
SortInfo sortInfo; /* Information about this sort that needs to
|
||||
* be passed to the comparison function. */
|
||||
# define NUM_LISTS 30
|
||||
@@ -3776,7 +3728,7 @@ Tcl_LsortObjCmd(
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
|
||||
&index) != TCL_OK) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
switch ((enum Lsort_Switches) index) {
|
||||
case LSORT_ASCII:
|
||||
@@ -3789,7 +3741,7 @@ Tcl_LsortObjCmd(
|
||||
"by comparison command", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
sortInfo.sortMode = SORTMODE_COMMAND;
|
||||
cmdPtr = objv[i+1];
|
||||
@@ -3805,7 +3757,7 @@ Tcl_LsortObjCmd(
|
||||
sortInfo.isIncreasing = 1;
|
||||
break;
|
||||
case LSORT_INDEX: {
|
||||
int indexc;
|
||||
int indexc, dummy;
|
||||
Tcl_Obj **indexv;
|
||||
|
||||
if (i == objc-2) {
|
||||
@@ -3814,12 +3766,12 @@ Tcl_LsortObjCmd(
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
if (TclListObjGetElements(interp, objv[i+1], &indexc,
|
||||
&indexv) != TCL_OK) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3831,24 +3783,12 @@ Tcl_LsortObjCmd(
|
||||
*/
|
||||
|
||||
for (j=0 ; j<indexc ; j++) {
|
||||
int encoded = 0;
|
||||
int result = TclIndexEncode(interp, indexv[j],
|
||||
TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &encoded);
|
||||
|
||||
if ((result == TCL_OK) && ((encoded == TCL_INDEX_BEFORE)
|
||||
|| (encoded == TCL_INDEX_AFTER))) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"index \"%s\" cannot select an element "
|
||||
"from any list", Tcl_GetString(indexv[j])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
|
||||
"OUTOFRANGE", NULL);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
if (result == TCL_ERROR) {
|
||||
if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
|
||||
&dummy) != TCL_OK) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (-index option item number %d)", j));
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
}
|
||||
indexPtr = objv[i+1];
|
||||
@@ -3877,11 +3817,11 @@ Tcl_LsortObjCmd(
|
||||
"followed by stride length", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
if (groupSize < 2) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
@@ -3889,7 +3829,7 @@ Tcl_LsortObjCmd(
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
|
||||
"BADSTRIDE", NULL);
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
group = 1;
|
||||
i++;
|
||||
@@ -3924,8 +3864,8 @@ Tcl_LsortObjCmd(
|
||||
* might be decreased by 1 later. */
|
||||
}
|
||||
for (j=0 ; j<sortInfo.indexc ; j++) {
|
||||
/* Prescreened values, no errors or out of range possible */
|
||||
TclIndexEncode(NULL, indexv[j], 0, 0, &sortInfo.indexv[j]);
|
||||
TclGetIntForIndexM(interp, indexv[j], SORTIDX_END,
|
||||
&sortInfo.indexv[j]);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3944,7 +3884,7 @@ Tcl_LsortObjCmd(
|
||||
listObj = TclListObjCopy(interp, listObj);
|
||||
if (listObj == NULL) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3962,7 +3902,7 @@ Tcl_LsortObjCmd(
|
||||
Tcl_IncrRefCount(newObjPtr);
|
||||
TclDecrRefCount(newObjPtr);
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done2;
|
||||
}
|
||||
Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
|
||||
sortInfo.compareCmdPtr = newCommandPtr;
|
||||
@@ -3996,7 +3936,10 @@ Tcl_LsortObjCmd(
|
||||
* offset of the element within each group by which to sort.
|
||||
*/
|
||||
|
||||
groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
|
||||
groupOffset = sortInfo.indexv[0];
|
||||
if (groupOffset <= SORTIDX_END) {
|
||||
groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1;
|
||||
}
|
||||
if (groupOffset < 0 || groupOffset >= groupSize) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"when used with \"-stride\", the leading \"-index\""
|
||||
@@ -4015,9 +3958,6 @@ Tcl_LsortObjCmd(
|
||||
/*
|
||||
* Do not shrink the actual memory block used; that doesn't
|
||||
* work with TclStackAlloc-allocated memory. [Bug 2918962]
|
||||
*
|
||||
* TODO: Consider a pointer increment to replace this
|
||||
* array shift.
|
||||
*/
|
||||
|
||||
for (i = 0; i < sortInfo.indexc; i++) {
|
||||
@@ -4055,7 +3995,7 @@ Tcl_LsortObjCmd(
|
||||
* begins sorting it into the sublists as it appears.
|
||||
*/
|
||||
|
||||
elementArray = ckalloc(length * sizeof(SortElement));
|
||||
elementArray = TclStackAlloc(interp, length * sizeof(SortElement));
|
||||
|
||||
for (i=0; i < length; i++){
|
||||
idx = groupSize * i + groupOffset;
|
||||
@@ -4065,7 +4005,7 @@ Tcl_LsortObjCmd(
|
||||
*/
|
||||
indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
|
||||
if (sortInfo.resultCode != TCL_OK) {
|
||||
goto done;
|
||||
goto done1;
|
||||
}
|
||||
} else {
|
||||
indexPtr = listObjPtrs[idx];
|
||||
@@ -4082,7 +4022,7 @@ Tcl_LsortObjCmd(
|
||||
|
||||
if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done1;
|
||||
}
|
||||
elementArray[i].collationKey.wideValue = a;
|
||||
} else if (sortMode == SORTMODE_REAL) {
|
||||
@@ -4091,7 +4031,7 @@ Tcl_LsortObjCmd(
|
||||
if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
|
||||
&a) != TCL_OK) {
|
||||
sortInfo.resultCode = TCL_ERROR;
|
||||
goto done;
|
||||
goto done1;
|
||||
}
|
||||
elementArray[i].collationKey.doubleValue = a;
|
||||
} else {
|
||||
@@ -4178,18 +4118,19 @@ Tcl_LsortObjCmd(
|
||||
Tcl_SetObjResult(interp, resultPtr);
|
||||
}
|
||||
|
||||
done1:
|
||||
TclStackFree(interp, elementArray);
|
||||
|
||||
done:
|
||||
if (sortMode == SORTMODE_COMMAND) {
|
||||
TclDecrRefCount(sortInfo.compareCmdPtr);
|
||||
TclDecrRefCount(listObj);
|
||||
sortInfo.compareCmdPtr = NULL;
|
||||
}
|
||||
done2:
|
||||
if (allocatedIndexVector) {
|
||||
TclStackFree(interp, sortInfo.indexv);
|
||||
}
|
||||
if (elementArray) {
|
||||
ckfree(elementArray);
|
||||
}
|
||||
return sortInfo.resultCode;
|
||||
}
|
||||
|
||||
@@ -4323,7 +4264,7 @@ SortCompare(
|
||||
int order = 0;
|
||||
|
||||
if (infoPtr->sortMode == SORTMODE_ASCII) {
|
||||
order = TclUtfCmp(elemPtr1->collationKey.strValuePtr,
|
||||
order = strcmp(elemPtr1->collationKey.strValuePtr,
|
||||
elemPtr2->collationKey.strValuePtr);
|
||||
} else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
|
||||
order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
|
||||
@@ -4430,7 +4371,7 @@ static int
|
||||
DictionaryCompare(
|
||||
const char *left, const char *right) /* The strings to compare. */
|
||||
{
|
||||
Tcl_UniChar uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower;
|
||||
Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
|
||||
int diff, zeros;
|
||||
int secondaryDiff = 0;
|
||||
|
||||
@@ -4499,8 +4440,8 @@ DictionaryCompare(
|
||||
*/
|
||||
|
||||
if ((*left != '\0') && (*right != '\0')) {
|
||||
left += TclUtfToUniChar(left, &uniLeft);
|
||||
right += TclUtfToUniChar(right, &uniRight);
|
||||
left += Tcl_UtfToUniChar(left, &uniLeft);
|
||||
right += Tcl_UtfToUniChar(right, &uniRight);
|
||||
|
||||
/*
|
||||
* Convert both chars to lower for the comparison, because
|
||||
@@ -4586,8 +4527,15 @@ SelectObjFromSublist(
|
||||
infoPtr->resultCode = TCL_ERROR;
|
||||
return NULL;
|
||||
}
|
||||
index = infoPtr->indexv[i];
|
||||
|
||||
index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);
|
||||
/*
|
||||
* Adjust for end-based indexing.
|
||||
*/
|
||||
|
||||
if (index < SORTIDX_NONE) {
|
||||
index += listLen + 1;
|
||||
}
|
||||
|
||||
if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
|
||||
¤tObj) != TCL_OK) {
|
||||
|
||||
+85
-189
@@ -309,7 +309,7 @@ Tcl_RegexpObjCmd(
|
||||
eflags = 0;
|
||||
} else if (offset > stringLength) {
|
||||
eflags = TCL_REG_NOTBOL;
|
||||
} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
|
||||
} else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
|
||||
eflags = 0;
|
||||
} else {
|
||||
eflags = TCL_REG_NOTBOL;
|
||||
@@ -487,27 +487,26 @@ Tcl_RegsubObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
|
||||
int start, end, subStart, subEnd, match, command, numParts;
|
||||
int start, end, subStart, subEnd, match;
|
||||
Tcl_RegExp regExpr;
|
||||
Tcl_RegExpInfo info;
|
||||
Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
|
||||
Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
|
||||
|
||||
static const char *const options[] = {
|
||||
"-all", "-command", "-expanded", "-line",
|
||||
"-linestop", "-lineanchor", "-nocase", "-start",
|
||||
"-all", "-nocase", "-expanded",
|
||||
"-line", "-linestop", "-lineanchor", "-start",
|
||||
"--", NULL
|
||||
};
|
||||
enum options {
|
||||
REGSUB_ALL, REGSUB_COMMAND, REGSUB_EXPANDED, REGSUB_LINE,
|
||||
REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE, REGSUB_START,
|
||||
REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED,
|
||||
REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START,
|
||||
REGSUB_LAST
|
||||
};
|
||||
|
||||
cflags = TCL_REG_ADVANCED;
|
||||
all = 0;
|
||||
offset = 0;
|
||||
command = 0;
|
||||
resultPtr = NULL;
|
||||
|
||||
for (idx = 1; idx < objc; idx++) {
|
||||
@@ -529,9 +528,6 @@ Tcl_RegsubObjCmd(
|
||||
case REGSUB_NOCASE:
|
||||
cflags |= TCL_REG_NOCASE;
|
||||
break;
|
||||
case REGSUB_COMMAND:
|
||||
command = 1;
|
||||
break;
|
||||
case REGSUB_EXPANDED:
|
||||
cflags |= TCL_REG_EXPANDED;
|
||||
break;
|
||||
@@ -589,7 +585,7 @@ Tcl_RegsubObjCmd(
|
||||
}
|
||||
}
|
||||
|
||||
if (all && (offset == 0) && (command == 0)
|
||||
if (all && (offset == 0)
|
||||
&& (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
|
||||
&& (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
|
||||
/*
|
||||
@@ -665,28 +661,6 @@ Tcl_RegsubObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (command) {
|
||||
/*
|
||||
* In command-prefix mode, we require that the third non-option
|
||||
* argument be a list, so we enforce that here. Afterwards, we fetch
|
||||
* the RE compilation again in case objv[0] and objv[2] are the same
|
||||
* object. (If they aren't, that's cheap to do.)
|
||||
*/
|
||||
|
||||
if (Tcl_ListObjLength(interp, objv[2], &numParts) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (numParts < 1) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"command prefix must be a list of at least one element",
|
||||
-1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGSUB",
|
||||
"CMDEMPTY", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
|
||||
}
|
||||
|
||||
/*
|
||||
* Make sure to avoid problems where the objects are shared. This can
|
||||
* cause RegExpObj <> UnicodeObj shimmering that causes data corruption.
|
||||
@@ -704,9 +678,7 @@ Tcl_RegsubObjCmd(
|
||||
} else {
|
||||
subPtr = objv[2];
|
||||
}
|
||||
if (!command) {
|
||||
wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
|
||||
}
|
||||
wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
|
||||
|
||||
result = TCL_OK;
|
||||
|
||||
@@ -764,90 +736,6 @@ Tcl_RegsubObjCmd(
|
||||
end = info.matches[0].end;
|
||||
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
|
||||
|
||||
/*
|
||||
* In command-prefix mode, the substitutions are added as quoted
|
||||
* arguments to the subSpec to form a command, that is then executed
|
||||
* and the result used as the string to substitute in. Actually,
|
||||
* everything is passed through Tcl_EvalObjv, as that's much faster.
|
||||
*/
|
||||
|
||||
if (command) {
|
||||
Tcl_Obj **args = NULL, **parts;
|
||||
int numArgs;
|
||||
|
||||
Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
|
||||
numArgs = numParts + info.nsubs + 1;
|
||||
args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
|
||||
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
|
||||
|
||||
for (idx = 0 ; idx <= info.nsubs ; idx++) {
|
||||
subStart = info.matches[idx].start;
|
||||
subEnd = info.matches[idx].end;
|
||||
if ((subStart >= 0) && (subEnd >= 0)) {
|
||||
args[idx + numParts] = Tcl_NewUnicodeObj(
|
||||
wstring + offset + subStart, subEnd - subStart);
|
||||
} else {
|
||||
args[idx + numParts] = Tcl_NewObj();
|
||||
}
|
||||
Tcl_IncrRefCount(args[idx + numParts]);
|
||||
}
|
||||
|
||||
/*
|
||||
* At this point, we're locally holding the references to the
|
||||
* argument words we added for this time round the loop, and the
|
||||
* subPtr is holding the references to the words that the user
|
||||
* supplied directly. None are zero-refcount, which is important
|
||||
* because Tcl_EvalObjv is "hairy monster" in terms of refcount
|
||||
* handling, being able to optionally add references to any of its
|
||||
* argument words. We'll drop the local refs immediately
|
||||
* afterwards; subPtr is handled in the main exit stanza.
|
||||
*/
|
||||
|
||||
result = Tcl_EvalObjv(interp, numArgs, args, 0);
|
||||
for (idx = 0 ; idx <= info.nsubs ; idx++) {
|
||||
TclDecrRefCount(args[idx + numParts]);
|
||||
}
|
||||
ckfree(args);
|
||||
if (result != TCL_OK) {
|
||||
if (result == TCL_ERROR) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (%s substitution computation script)",
|
||||
options[REGSUB_COMMAND]));
|
||||
}
|
||||
goto done;
|
||||
}
|
||||
|
||||
Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
/*
|
||||
* Refetch the unicode, in case the representation was smashed by
|
||||
* the user code.
|
||||
*/
|
||||
|
||||
wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
|
||||
|
||||
offset += end;
|
||||
if (end == 0 || start == end) {
|
||||
/*
|
||||
* Always consume at least one character of the input string
|
||||
* in order to prevent infinite loops, even when we
|
||||
* technically matched the empty string; we must not match
|
||||
* again at the same spot.
|
||||
*/
|
||||
|
||||
if (offset < wlen) {
|
||||
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
|
||||
}
|
||||
offset++;
|
||||
}
|
||||
if (all) {
|
||||
continue;
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Append the subSpec argument to the variable, making appropriate
|
||||
* substitutions. This code is a bit hairy because of the backslash
|
||||
@@ -1173,7 +1061,7 @@ Tcl_SplitObjCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
int len;
|
||||
const char *splitChars;
|
||||
const char *stringPtr;
|
||||
@@ -1216,22 +1104,13 @@ Tcl_SplitObjCmd(
|
||||
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
|
||||
|
||||
for ( ; stringPtr < end; stringPtr += len) {
|
||||
int fullchar;
|
||||
len = TclUtfToUniChar(stringPtr, &ch);
|
||||
fullchar = ch;
|
||||
|
||||
#if TCL_UTF_MAX == 4
|
||||
if (!len) {
|
||||
len += TclUtfToUniChar(stringPtr, &ch);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Assume Tcl_UniChar is an integral type...
|
||||
*/
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(fullchar),
|
||||
hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
|
||||
&isNew);
|
||||
if (isNew) {
|
||||
TclNewStringObj(objPtr, stringPtr, len);
|
||||
@@ -1267,7 +1146,7 @@ Tcl_SplitObjCmd(
|
||||
} else {
|
||||
const char *element, *p, *splitEnd;
|
||||
int splitLen;
|
||||
Tcl_UniChar splitChar = 0;
|
||||
Tcl_UniChar splitChar;
|
||||
|
||||
/*
|
||||
* Normal case: split on any of a given set of characters. Discard
|
||||
@@ -1335,8 +1214,16 @@ StringFirstCmd(
|
||||
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (start < 0) {
|
||||
start = 0;
|
||||
}
|
||||
if (start >= size) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFirst(objv[1],
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringFind(objv[1],
|
||||
objv[2], start)));
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1380,6 +1267,14 @@ StringLastCmd(
|
||||
if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (last < 0) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
|
||||
return TCL_OK;
|
||||
}
|
||||
if (last >= size) {
|
||||
last = size - 1;
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(TclStringLast(objv[1],
|
||||
objv[2], last)));
|
||||
@@ -1475,7 +1370,7 @@ StringIsCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
const char *string1, *end, *stop;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
int (*chcomp)(int) = NULL; /* The UniChar comparison function. */
|
||||
int i, failat = 0, result = 1, strict = 0, index, length1, length2;
|
||||
Tcl_Obj *objPtr, *failVarObj = NULL;
|
||||
@@ -1572,11 +1467,11 @@ StringIsCmd(
|
||||
string1 = TclGetStringFromObj(objPtr, &length1);
|
||||
result = length1 == 0;
|
||||
}
|
||||
} else if (index != STR_IS_BOOL) {
|
||||
TclGetBooleanFromObj(NULL, objPtr, &i);
|
||||
if ((index == STR_IS_TRUE) ^ i) {
|
||||
result = 0;
|
||||
}
|
||||
} else if (((index == STR_IS_TRUE) &&
|
||||
objPtr->internalRep.longValue == 0)
|
||||
|| ((index == STR_IS_FALSE) &&
|
||||
objPtr->internalRep.longValue != 0)) {
|
||||
result = 0;
|
||||
}
|
||||
break;
|
||||
case STR_IS_CONTROL:
|
||||
@@ -1586,8 +1481,12 @@ StringIsCmd(
|
||||
chcomp = Tcl_UniCharIsDigit;
|
||||
break;
|
||||
case STR_IS_DOUBLE: {
|
||||
/* TODO */
|
||||
if ((objPtr->typePtr == &tclDoubleType) ||
|
||||
(objPtr->typePtr == &tclIntType) ||
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
(objPtr->typePtr == &tclWideIntType) ||
|
||||
#endif
|
||||
(objPtr->typePtr == &tclBignumType)) {
|
||||
break;
|
||||
}
|
||||
@@ -1622,6 +1521,9 @@ StringIsCmd(
|
||||
goto failedIntParse;
|
||||
case STR_IS_ENTIER:
|
||||
if ((objPtr->typePtr == &tclIntType) ||
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
(objPtr->typePtr == &tclWideIntType) ||
|
||||
#endif
|
||||
(objPtr->typePtr == &tclBignumType)) {
|
||||
break;
|
||||
}
|
||||
@@ -1663,7 +1565,7 @@ StringIsCmd(
|
||||
}
|
||||
break;
|
||||
case STR_IS_WIDE:
|
||||
if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
|
||||
if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -1800,16 +1702,8 @@ StringIsCmd(
|
||||
}
|
||||
end = string1 + length1;
|
||||
for (; string1 < end; string1 += length2, failat++) {
|
||||
int fullchar;
|
||||
length2 = TclUtfToUniChar(string1, &ch);
|
||||
fullchar = ch;
|
||||
#if TCL_UTF_MAX == 4
|
||||
if (!length2) {
|
||||
length2 = TclUtfToUniChar(string1, &ch);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
|
||||
}
|
||||
#endif
|
||||
if (!chcomp(fullchar)) {
|
||||
if (!chcomp(ch)) {
|
||||
result = 0;
|
||||
break;
|
||||
}
|
||||
@@ -2271,12 +2165,11 @@ StringReptCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
resultPtr = TclStringRepeat(interp, objv[1], count, TCL_STRING_IN_PLACE);
|
||||
if (resultPtr) {
|
||||
Tcl_SetObjResult(interp, resultPtr);
|
||||
return TCL_OK;
|
||||
if (TCL_OK != TclStringRepeat(interp, objv[1], count, &resultPtr)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, resultPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2304,50 +2197,42 @@ StringRplcCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
int first, last, length, end;
|
||||
Tcl_UniChar *ustring;
|
||||
int first, last, length;
|
||||
|
||||
if (objc < 4 || objc > 5) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
length = Tcl_GetCharLength(objv[1]);
|
||||
end = length - 1;
|
||||
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
|
||||
length--;
|
||||
|
||||
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
|
||||
TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
|
||||
if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
|
||||
TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK){
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* The following test screens out most empty substrings as
|
||||
* candidates for replacement. When they are detected, no
|
||||
* replacement is done, and the result is the original string,
|
||||
*/
|
||||
if ((last < 0) || /* Range ends before start of string */
|
||||
(first > end) || /* Range begins after end of string */
|
||||
(last < first)) { /* Range begins after it starts */
|
||||
|
||||
/*
|
||||
* BUT!!! when (end < 0) -- an empty original string -- we can
|
||||
* have (first <= end < 0 <= last) and an empty string is permitted
|
||||
* to be replaced.
|
||||
*/
|
||||
if ((last < first) || (last < 0) || (first > length)) {
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
} else {
|
||||
Tcl_Obj *resultPtr;
|
||||
|
||||
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
|
||||
length--;
|
||||
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
if (last > end) {
|
||||
last = end;
|
||||
|
||||
resultPtr = Tcl_NewUnicodeObj(ustring, first);
|
||||
if (objc == 5) {
|
||||
Tcl_AppendObjToObj(resultPtr, objv[4]);
|
||||
}
|
||||
if (last < length) {
|
||||
Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
|
||||
length - last);
|
||||
}
|
||||
|
||||
resultPtr = TclStringReplace(interp, objv[1], first,
|
||||
last + 1 - first, (objc == 5) ? objv[4] : NULL,
|
||||
TCL_STRING_IN_PLACE);
|
||||
|
||||
Tcl_SetObjResult(interp, resultPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
@@ -2383,7 +2268,7 @@ StringRevCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
|
||||
Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2413,7 +2298,7 @@ StringStartCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
const char *p, *string;
|
||||
int cur, index, length, numChars;
|
||||
|
||||
@@ -2474,7 +2359,7 @@ StringEndCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
const char *p, *end, *string;
|
||||
int cur, index, length, numChars;
|
||||
|
||||
@@ -2832,6 +2717,7 @@ StringCatCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
int code;
|
||||
Tcl_Obj *objResultPtr;
|
||||
|
||||
if (objc < 2) {
|
||||
@@ -2841,15 +2727,23 @@ StringCatCmd(
|
||||
*/
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objc == 2) {
|
||||
/*
|
||||
* Other trivial case, single arg, just return it.
|
||||
*/
|
||||
Tcl_SetObjResult(interp, objv[1]);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE);
|
||||
code = TclStringCatObjv(interp, /* inPlace */ 1, objc-1, objv+1,
|
||||
&objResultPtr);
|
||||
|
||||
if (objResultPtr) {
|
||||
if (code == TCL_OK) {
|
||||
Tcl_SetObjResult(interp, objResultPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
return TCL_ERROR;
|
||||
return code;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2870,6 +2764,7 @@ StringCatCmd(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
StringBytesCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
@@ -3217,7 +3112,8 @@ StringTrimCmd(
|
||||
}
|
||||
string1 = TclGetStringFromObj(objv[1], &length1);
|
||||
|
||||
triml = TclTrim(string1, length1, string2, length2, &trimr);
|
||||
triml = TclTrimLeft(string1, length1, string2, length2);
|
||||
trimr = TclTrimRight(string1 + triml, length1 - triml, string2, length2);
|
||||
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewStringObj(string1 + triml, length1 - triml - trimr));
|
||||
@@ -3522,7 +3418,7 @@ TclNRSwitchObjCmd(
|
||||
OPT_LAST
|
||||
};
|
||||
typedef int (*strCmpFn_t)(const char *, const char *);
|
||||
strCmpFn_t strCmpFn = TclUtfCmp;
|
||||
strCmpFn_t strCmpFn = strcmp;
|
||||
|
||||
mode = OPT_EXACT;
|
||||
foundmode = 0;
|
||||
@@ -4285,7 +4181,7 @@ TclNRTryObjCmd(
|
||||
}
|
||||
|
||||
info[0] = objv[i]; /* type */
|
||||
TclNewIntObj(info[1], code); /* returnCode */
|
||||
TclNewLongObj(info[1], code); /* returnCode */
|
||||
if (info[2] == NULL) { /* errorCodePrefix */
|
||||
TclNewObj(info[2]);
|
||||
}
|
||||
|
||||
@@ -734,105 +734,6 @@ TclCompileCatchCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCompileClockClicksCmd --
|
||||
*
|
||||
* Procedure called to compile the "tcl::clock::clicks" command.
|
||||
*
|
||||
* Results:
|
||||
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
|
||||
* evaluation to run time.
|
||||
*
|
||||
* Side effects:
|
||||
* Instructions are added to envPtr to execute the "clock clicks"
|
||||
* command at runtime.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCompileClockClicksCmd(
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token* tokenPtr;
|
||||
|
||||
switch (parsePtr->numWords) {
|
||||
case 1:
|
||||
/*
|
||||
* No args
|
||||
*/
|
||||
TclEmitInstInt1(INST_CLOCK_READ, 0, envPtr);
|
||||
break;
|
||||
case 2:
|
||||
/*
|
||||
* -milliseconds or -microseconds
|
||||
*/
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD
|
||||
|| tokenPtr[1].size < 4
|
||||
|| tokenPtr[1].size > 13) {
|
||||
return TCL_ERROR;
|
||||
} else if (!strncmp(tokenPtr[1].start, "-microseconds",
|
||||
tokenPtr[1].size)) {
|
||||
TclEmitInstInt1(INST_CLOCK_READ, 1, envPtr);
|
||||
break;
|
||||
} else if (!strncmp(tokenPtr[1].start, "-milliseconds",
|
||||
tokenPtr[1].size)) {
|
||||
TclEmitInstInt1(INST_CLOCK_READ, 2, envPtr);
|
||||
break;
|
||||
} else {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
default:
|
||||
return TCL_ERROR;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
/*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCompileClockReadingCmd --
|
||||
*
|
||||
* Procedure called to compile the "tcl::clock::microseconds",
|
||||
* "tcl::clock::milliseconds" and "tcl::clock::seconds" commands.
|
||||
*
|
||||
* Results:
|
||||
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
|
||||
* evaluation to run time.
|
||||
*
|
||||
* Side effects:
|
||||
* Instructions are added to envPtr to execute the "clock clicks"
|
||||
* command at runtime.
|
||||
*
|
||||
* Client data is 1 for microseconds, 2 for milliseconds, 3 for seconds.
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCompileClockReadingCmd(
|
||||
Tcl_Interp* interp, /* Tcl interpreter */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
if (parsePtr->numWords != 1) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
TclEmitInstInt1(INST_CLOCK_READ, PTR2INT(cmdPtr->objClientData), envPtr);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+257
-182
@@ -28,39 +28,56 @@ static void CompileReturnInternal(CompileEnv *envPtr,
|
||||
static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
|
||||
|
||||
#define INDEX_END (-2)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclGetIndexFromToken --
|
||||
* GetIndexFromToken --
|
||||
*
|
||||
* Parse a token to determine if an index value is known at
|
||||
* compile time.
|
||||
* Parse a token and get the encoded version of the index (as understood
|
||||
* by TEBC), assuming it is at all knowable at compile time. Only handles
|
||||
* indices that are integers or 'end' or 'end-integer'.
|
||||
*
|
||||
* Returns:
|
||||
* TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
|
||||
*
|
||||
* Side effects:
|
||||
* When TCL_OK is returned, the encoded index value is written
|
||||
* to *index.
|
||||
* Sets *index to the index value if successful.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclGetIndexFromToken(
|
||||
static inline int
|
||||
GetIndexFromToken(
|
||||
Tcl_Token *tokenPtr,
|
||||
int before,
|
||||
int after,
|
||||
int *indexPtr)
|
||||
int *index)
|
||||
{
|
||||
Tcl_Obj *tmpObj = Tcl_NewObj();
|
||||
int result = TCL_ERROR;
|
||||
int result, idx;
|
||||
|
||||
if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
|
||||
result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr);
|
||||
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
|
||||
Tcl_DecrRefCount(tmpObj);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
result = TclGetIntFromObj(NULL, tmpObj, &idx);
|
||||
if (result == TCL_OK) {
|
||||
if (idx < 0) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
|
||||
if (result == TCL_OK && idx > INDEX_END) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_DecrRefCount(tmpObj);
|
||||
|
||||
if (result == TCL_OK) {
|
||||
*index = idx;
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -127,7 +144,7 @@ TclCompileGlobalCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* TODO: Consider what value can pass through the
|
||||
/* TODO: Consider what value can pass throug the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
@@ -1036,7 +1053,7 @@ TclCompileLassignCmd(
|
||||
*/
|
||||
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1087,14 +1104,14 @@ TclCompileLindexCmd(
|
||||
}
|
||||
|
||||
idxTokenPtr = TokenAfter(valTokenPtr);
|
||||
if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_BEFORE,
|
||||
&idx) == TCL_OK) {
|
||||
if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) {
|
||||
/*
|
||||
* The idxTokenPtr parsed as a valid index value and was
|
||||
* encoded as expected by INST_LIST_INDEX_IMM.
|
||||
*
|
||||
* NOTE: that we rely on indexing before a list producing the
|
||||
* same result as indexing after a list.
|
||||
* All checks have been completed, and we have exactly one of these
|
||||
* constructs:
|
||||
* lindex <arbitraryValue> <posInt>
|
||||
* lindex <arbitraryValue> end-<posInt>
|
||||
* This is best compiled as a push of the arbitrary value followed by
|
||||
* an "immediate lindex" which is the most efficient variety.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valTokenPtr, interp, 1);
|
||||
@@ -1241,7 +1258,7 @@ TclCompileListCmd(
|
||||
|
||||
if (concat && numWords == 2) {
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -1315,25 +1332,21 @@ TclCompileLrangeCmd(
|
||||
}
|
||||
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
|
||||
tokenPtr = TokenAfter(listTokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
|
||||
&idx1) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/*
|
||||
* Token was an index value, and we treat all "first" indices
|
||||
* before the list same as the start of the list.
|
||||
* Parse the indices. Will only compile if both are constants and not an
|
||||
* _integer_ less than zero (since we reserve negative indices here for
|
||||
* end-relative indexing) or an end-based index greater than 'end' itself.
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(listTokenPtr);
|
||||
if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
|
||||
&idx2) != TCL_OK) {
|
||||
if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/*
|
||||
* Token was an index value, and we treat all "last" indices
|
||||
* after the list same as the end of the list.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Issue instructions. It's not safe to skip doing the LIST_RANGE, as
|
||||
@@ -1383,30 +1396,21 @@ TclCompileLinsertCmd(
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(listTokenPtr);
|
||||
|
||||
/*
|
||||
* NOTE: This command treats all inserts at indices before the list
|
||||
* the same as inserts at the start of the list, and all inserts
|
||||
* after the list the same as inserts at the end of the list. We
|
||||
* make that transformation here so we can use the optimized bytecode
|
||||
* as much as possible.
|
||||
*/
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END,
|
||||
&idx) != TCL_OK) {
|
||||
if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* There are four main cases. If there are no values to insert, this is
|
||||
* just a confirm-listiness check. If the index is '0', this is a prepend.
|
||||
* If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,
|
||||
* If the index is 'end' (== INDEX_END), this is an append. Otherwise,
|
||||
* this is a splice (== split, insert values as list, concat-3).
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
if (parsePtr->numWords == 3) {
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -1416,25 +1420,13 @@ TclCompileLinsertCmd(
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, i-3, envPtr);
|
||||
|
||||
if (idx == TCL_INDEX_START) {
|
||||
if (idx == 0 /*start*/) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
} else if (idx == TCL_INDEX_END) {
|
||||
} else if (idx == INDEX_END /*end*/) {
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
} else {
|
||||
/*
|
||||
* Here we handle two ranges for idx. First when idx > 0, we
|
||||
* want the first half of the split to end at index idx-1 and
|
||||
* the second half to start at index idx.
|
||||
* Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
|
||||
* we want the first half of the split to end at index end-N and
|
||||
* the second half to start at index end-N+1. We accomplish this
|
||||
* with a pre-adjustment of the end-N value.
|
||||
* The root of this is that the commands [lrange] and [linsert]
|
||||
* differ in their interpretation of the "end" index.
|
||||
*/
|
||||
|
||||
if (idx < TCL_INDEX_END) {
|
||||
if (idx < 0) {
|
||||
idx++;
|
||||
}
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
@@ -1442,7 +1434,7 @@ TclCompileLinsertCmd(
|
||||
TclEmitInt4( idx-1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
@@ -1472,167 +1464,250 @@ TclCompileLreplaceCmd(
|
||||
{
|
||||
Tcl_Token *tokenPtr, *listTokenPtr;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Obj *tmpObj;
|
||||
int idx1, idx2, i, offset, offset2;
|
||||
int emptyPrefix=1, suffixStart = 0;
|
||||
|
||||
if (parsePtr->numWords < 4) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
|
||||
/*
|
||||
* Parse the indices. Will only compile if both are constants and not an
|
||||
* _integer_ less than zero (since we reserve negative indices here for
|
||||
* end-relative indexing) or an end-based index greater than 'end' itself.
|
||||
*/
|
||||
|
||||
tokenPtr = TokenAfter(listTokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
|
||||
&idx1) != TCL_OK) {
|
||||
if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
|
||||
&idx2) != TCL_OK) {
|
||||
if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* idx1, idx2 are the conventional encoded forms of the tokens parsed
|
||||
* as all forms of index values. Values of idx1 that come before the
|
||||
* list are treated the same as if they were the start of the list.
|
||||
* Values of idx2 that come after the list are treated the same as if
|
||||
* they were the end of the list.
|
||||
*/
|
||||
|
||||
if (idx1 == TCL_INDEX_AFTER) {
|
||||
/*
|
||||
* [lreplace] treats idx1 value end+1 differently from end+2, etc.
|
||||
* The operand encoding cannot distinguish them, so we must bail
|
||||
* out to direct evaluation.
|
||||
*/
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* General structure of the [lreplace] result is
|
||||
* prefix replacement suffix
|
||||
* In a few cases we can predict various parts will be empty and
|
||||
* take advantage.
|
||||
* idx1, idx2 are now in canonical form:
|
||||
*
|
||||
* The proper suffix begins with the greater of indices idx1 or
|
||||
* idx2 + 1. If we cannot tell at compile time which is greater,
|
||||
* we must defer to direct evaluation.
|
||||
* - integer: [0,len+1]
|
||||
* - end index: INDEX_END
|
||||
* - -ive offset: INDEX_END-[len-1,0]
|
||||
* - +ive offset: INDEX_END+1
|
||||
*/
|
||||
|
||||
if (idx2 == TCL_INDEX_BEFORE) {
|
||||
suffixStart = idx1;
|
||||
} else if (idx2 == TCL_INDEX_END) {
|
||||
suffixStart = TCL_INDEX_AFTER;
|
||||
} else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
|
||||
|| ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
|
||||
suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
|
||||
} else {
|
||||
/*
|
||||
* Compilation fails when one index is end-based but the other isn't.
|
||||
* Fixing this will require more bytecodes, but this is a workaround for
|
||||
* now. [Bug 47ac84309b]
|
||||
*/
|
||||
|
||||
if ((idx1 <= INDEX_END) != (idx2 <= INDEX_END)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* All paths start with computing/pushing the original value. */
|
||||
if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
|
||||
idx2 = idx1 - 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Work out what this [lreplace] is actually doing.
|
||||
*/
|
||||
|
||||
tmpObj = NULL;
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
|
||||
/*
|
||||
* Push all the replacement values next so any errors raised in
|
||||
* creating them get raised first.
|
||||
*/
|
||||
if (parsePtr->numWords > 4) {
|
||||
/* Push the replacement arguments */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
for (i=4 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
|
||||
/* Make a list of them... */
|
||||
TclEmitInstInt4( INST_LIST, i - 4, envPtr);
|
||||
|
||||
emptyPrefix = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* [lreplace] raises an error when idx1 points after the list, but
|
||||
* only when the list is not empty. This is maximum stupidity.
|
||||
*
|
||||
* TODO: TIP this nonsense away!
|
||||
*/
|
||||
if (idx1 >= TCL_INDEX_START) {
|
||||
if (emptyPrefix) {
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
if (parsePtr->numWords == 4) {
|
||||
if (idx1 == 0) {
|
||||
if (idx2 == INDEX_END) {
|
||||
goto dropAll;
|
||||
}
|
||||
idx1 = idx2 + 1;
|
||||
idx2 = INDEX_END;
|
||||
goto dropEnd;
|
||||
} else if (idx2 == INDEX_END) {
|
||||
idx2 = idx1 - 1;
|
||||
idx1 = 0;
|
||||
goto dropEnd;
|
||||
} else {
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
if (idx2 < idx1) {
|
||||
idx2 = idx1 - 1;
|
||||
}
|
||||
if (idx1 > 0) {
|
||||
tmpObj = Tcl_NewIntObj(idx1);
|
||||
Tcl_IncrRefCount(tmpObj);
|
||||
}
|
||||
goto dropRange;
|
||||
}
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
offset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
}
|
||||
|
||||
/* List is not empty */
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
|
||||
NULL), envPtr);
|
||||
TclEmitOpcode( INST_GT, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
for (i=4 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, i - 4, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
if (idx1 == 0) {
|
||||
if (idx2 == INDEX_END) {
|
||||
goto replaceAll;
|
||||
}
|
||||
idx1 = idx2 + 1;
|
||||
idx2 = INDEX_END;
|
||||
goto replaceHead;
|
||||
} else if (idx2 == INDEX_END) {
|
||||
idx2 = idx1 - 1;
|
||||
idx1 = 0;
|
||||
goto replaceTail;
|
||||
} else {
|
||||
if (idx2 < idx1) {
|
||||
idx2 = idx1 - 1;
|
||||
}
|
||||
if (idx1 > 0) {
|
||||
tmpObj = Tcl_NewIntObj(idx1);
|
||||
Tcl_IncrRefCount(tmpObj);
|
||||
}
|
||||
goto replaceRange;
|
||||
}
|
||||
|
||||
/*
|
||||
* Issue instructions to perform the operations relating to configurations
|
||||
* that just drop. The only argument pushed on the stack is the list to
|
||||
* operate on.
|
||||
*/
|
||||
|
||||
dropAll: /* This just ensures the arg is a list. */
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
PushStringLiteral(envPtr, "");
|
||||
goto done;
|
||||
|
||||
dropEnd:
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
|
||||
TclEmitInt4( idx2, envPtr);
|
||||
goto done;
|
||||
|
||||
dropRange:
|
||||
if (tmpObj != NULL) {
|
||||
/*
|
||||
* Emit bytecode to check the list length.
|
||||
*/
|
||||
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
|
||||
TclEmitOpcode( INST_GE, envPtr);
|
||||
offset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
|
||||
|
||||
/* Idx1 >= list length ===> raise an error */
|
||||
/*
|
||||
* Emit an error if we've been given an empty list.
|
||||
*/
|
||||
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %d", idx1), NULL), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
|
||||
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
|
||||
envPtr->codeStart + offset + 1);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
|
||||
envPtr->codeStart + offset2 + 1);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
}
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx1 - 1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
|
||||
/*
|
||||
* Issue instructions to perform the operations relating to configurations
|
||||
* that do real replacement. All arguments are pushed and assembled into a
|
||||
* pair: the list of values to replace with, and the list to do the
|
||||
* surgery on.
|
||||
*/
|
||||
|
||||
replaceAll:
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
goto done;
|
||||
|
||||
replaceHead:
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
|
||||
TclEmitInt4( idx2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
replaceTail:
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
|
||||
TclEmitInt4( idx2, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
replaceRange:
|
||||
if (tmpObj != NULL) {
|
||||
/*
|
||||
* This is a "no-op". Example: [lreplace {a b c} 2 0]
|
||||
* We still do a list operation to get list-verification
|
||||
* and canonicalization side effects.
|
||||
* Emit bytecode to check the list length.
|
||||
*/
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (idx1 != TCL_INDEX_START) {
|
||||
/* Prefix may not be empty; generate bytecode to push it */
|
||||
if (emptyPrefix) {
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
} else {
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx1 - 1, envPtr);
|
||||
if (!emptyPrefix) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
emptyPrefix = 0;
|
||||
}
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
|
||||
if (!emptyPrefix) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
}
|
||||
/*
|
||||
* Check the list length vs idx1.
|
||||
*/
|
||||
|
||||
if (suffixStart == TCL_INDEX_AFTER) {
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
if (emptyPrefix) {
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
} else {
|
||||
/* Suffix may not be empty; generate bytecode to push it */
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, suffixStart, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
if (!emptyPrefix) {
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
}
|
||||
}
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
|
||||
TclEmitOpcode( INST_GE, envPtr);
|
||||
offset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
|
||||
|
||||
/*
|
||||
* Emit an error if we've been given an empty list.
|
||||
*/
|
||||
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %d", idx1), NULL), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
|
||||
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
|
||||
envPtr->codeStart + offset + 1);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
|
||||
envPtr->codeStart + offset2 + 1);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
}
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx1 - 1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
/*
|
||||
* Clean up the allocated memory.
|
||||
*/
|
||||
|
||||
done:
|
||||
if (tmpObj != NULL) {
|
||||
Tcl_DecrRefCount(tmpObj);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2858,7 +2933,7 @@ TclCompileVariableCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* TODO: Consider what value can pass through the
|
||||
/* TODO: Consider what value can pass throug the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
|
||||
+146
-192
@@ -107,6 +107,58 @@ const AuxDataType tclJumptableInfoType = {
|
||||
#define INVOKE(name) \
|
||||
TclEmitInvoke(envPtr,INST_##name)
|
||||
|
||||
#define INDEX_END (-2)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* GetIndexFromToken --
|
||||
*
|
||||
* Parse a token and get the encoded version of the index (as understood
|
||||
* by TEBC), assuming it is at all knowable at compile time. Only handles
|
||||
* indices that are integers or 'end' or 'end-integer'.
|
||||
*
|
||||
* Returns:
|
||||
* TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
|
||||
*
|
||||
* Side effects:
|
||||
* Sets *index to the index value if successful.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
GetIndexFromToken(
|
||||
Tcl_Token *tokenPtr,
|
||||
int *index)
|
||||
{
|
||||
Tcl_Obj *tmpObj = Tcl_NewObj();
|
||||
int result, idx;
|
||||
|
||||
if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
|
||||
Tcl_DecrRefCount(tmpObj);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
result = TclGetIntFromObj(NULL, tmpObj, &idx);
|
||||
if (result == TCL_OK) {
|
||||
if (idx < 0) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx);
|
||||
if (result == TCL_OK && idx > INDEX_END) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_DecrRefCount(tmpObj);
|
||||
|
||||
if (result == TCL_OK) {
|
||||
*index = idx;
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -930,48 +982,22 @@ TclCompileStringRangeCmd(
|
||||
fromTokenPtr = TokenAfter(stringTokenPtr);
|
||||
toTokenPtr = TokenAfter(fromTokenPtr);
|
||||
|
||||
/* Every path must push the string argument */
|
||||
CompileWord(envPtr, stringTokenPtr, interp, 1);
|
||||
|
||||
/*
|
||||
* Parse the two indices.
|
||||
*/
|
||||
|
||||
if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
|
||||
&idx1) != TCL_OK) {
|
||||
if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) {
|
||||
goto nonConstantIndices;
|
||||
}
|
||||
/*
|
||||
* Token parsed as an index expression. We treat all indices before
|
||||
* the string the same as the start of the string.
|
||||
*/
|
||||
|
||||
if (idx1 == TCL_INDEX_AFTER) {
|
||||
/* [string range $s end+1 $last] must be empty string */
|
||||
OP( POP);
|
||||
PUSH( "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
|
||||
&idx2) != TCL_OK) {
|
||||
if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) {
|
||||
goto nonConstantIndices;
|
||||
}
|
||||
/*
|
||||
* Token parsed as an index expression. We treat all indices after
|
||||
* the string the same as the end of the string.
|
||||
*/
|
||||
if (idx2 == TCL_INDEX_BEFORE) {
|
||||
/* [string range $s $first -1] must be empty string */
|
||||
OP( POP);
|
||||
PUSH( "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Push the operand onto the stack and then the substring operation.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, stringTokenPtr, interp, 1);
|
||||
OP44( STR_RANGE_IMM, idx1, idx2);
|
||||
return TCL_OK;
|
||||
|
||||
@@ -980,6 +1006,7 @@ TclCompileStringRangeCmd(
|
||||
*/
|
||||
|
||||
nonConstantIndices:
|
||||
CompileWord(envPtr, stringTokenPtr, interp, 1);
|
||||
CompileWord(envPtr, fromTokenPtr, interp, 2);
|
||||
CompileWord(envPtr, toTokenPtr, interp, 3);
|
||||
OP( STR_RANGE);
|
||||
@@ -995,197 +1022,124 @@ TclCompileStringReplaceCmd(
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds the resulting instructions. */
|
||||
{
|
||||
Tcl_Token *tokenPtr, *valueTokenPtr;
|
||||
Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int first, last;
|
||||
int idx1, idx2;
|
||||
|
||||
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* Bytecode to compute/push string argument being replaced */
|
||||
valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 1);
|
||||
|
||||
/*
|
||||
* Check for first index known and useful at compile time.
|
||||
*/
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
|
||||
&first) != TCL_OK) {
|
||||
goto genericReplace;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for last index known and useful at compile time.
|
||||
*/
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
|
||||
&last) != TCL_OK) {
|
||||
goto genericReplace;
|
||||
}
|
||||
|
||||
/*
|
||||
* [string replace] is an odd bird. For many arguments it is
|
||||
* a conventional substring replacer. However it also goes out
|
||||
* of its way to become a no-op for many cases where it would be
|
||||
* replacing an empty substring. Precisely, it is a no-op when
|
||||
*
|
||||
* (last < first) OR
|
||||
* (last < 0) OR
|
||||
* (end < first)
|
||||
*
|
||||
* For some compile-time values we can detect these cases, and
|
||||
* compile direct to bytecode implementing the no-op.
|
||||
*/
|
||||
|
||||
if ((last == TCL_INDEX_BEFORE) /* Know (last < 0) */
|
||||
|| (first == TCL_INDEX_AFTER) /* Know (first > end) */
|
||||
|
||||
/*
|
||||
* Tricky to determine when runtime (last < first) can be
|
||||
* certainly known based on the encoded values. Consider the
|
||||
* cases...
|
||||
*
|
||||
* (first <= TCL_INDEX_END) &&
|
||||
* (last == TCL_INDEX_AFTER) => cannot tell REJECT
|
||||
* (last <= TCL_INDEX END) && (last < first) => ACCEPT
|
||||
* else => cannot tell REJECT
|
||||
*/
|
||||
|| ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END)
|
||||
&& (last < first)) /* Know (last < first) */
|
||||
/*
|
||||
* (first == TCL_INDEX_BEFORE) &&
|
||||
* (last == TCL_INDEX_AFTER) => (first < last) REJECT
|
||||
* (last <= TCL_INDEX_END) => cannot tell REJECT
|
||||
* else => (first < last) REJECT
|
||||
*
|
||||
* else [[first >= TCL_INDEX_START]] &&
|
||||
* (last == TCL_INDEX_AFTER) => cannot tell REJECT
|
||||
* (last <= TCL_INDEX_END) => cannot tell REJECT
|
||||
* else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
|
||||
*/
|
||||
|| ((first >= TCL_INDEX_START) && (last >= TCL_INDEX_START)
|
||||
&& (last < first))) { /* Know (last < first) */
|
||||
if (parsePtr->numWords == 5) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
OP( POP); /* Pop newString */
|
||||
}
|
||||
/* Original string argument now on TOS as result */
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (parsePtr->numWords == 5) {
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
replacementTokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* When we have a string replacement, we have to take care about
|
||||
* not replacing empty substrings that [string replace] promises
|
||||
* not to replace
|
||||
*
|
||||
* The remaining index values might be suitable for conventional
|
||||
* string replacement, but only if they cannot possibly meet the
|
||||
* conditions described above at runtime. If there's a chance they
|
||||
* might, we would have to emit bytecode to check and at that point
|
||||
* we're paying more in bytecode execution time than would make
|
||||
* things worthwhile. Trouble is we are very limited in
|
||||
* how much we can detect that at compile time. After decoding,
|
||||
* we need, first:
|
||||
*
|
||||
* (first <= end)
|
||||
*
|
||||
* The encoded indices (first <= TCL_INDEX END) and
|
||||
* (first == TCL_INDEX_BEFORE) always meets this condition, but
|
||||
* any other encoded first index has some list for which it fails.
|
||||
*
|
||||
* We also need, second:
|
||||
*
|
||||
* (last >= 0)
|
||||
*
|
||||
* The encoded indices (last >= TCL_INDEX_START) and
|
||||
* (last == TCL_INDEX_AFTER) always meet this condition but any
|
||||
* other encoded last index has some list for which it fails.
|
||||
*
|
||||
* Finally we need, third:
|
||||
*
|
||||
* (first <= last)
|
||||
*
|
||||
* Considered in combination with the constraints we already have,
|
||||
* we see that we can proceed when (first == TCL_INDEX_BEFORE)
|
||||
* or (last == TCL_INDEX_AFTER). These also permit simplification
|
||||
* of the prefix|replace|suffix construction. The other constraints,
|
||||
* though, interfere with getting a guarantee that first <= last.
|
||||
* Parse the indices. Will only compile special cases if both are
|
||||
* constants and not an _integer_ less than zero (since we reserve
|
||||
* negative indices here for end-relative indexing) or an end-based index
|
||||
* greater than 'end' itself.
|
||||
*/
|
||||
|
||||
if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) {
|
||||
/* empty prefix */
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
OP4( REVERSE, 2);
|
||||
if (last == TCL_INDEX_AFTER) {
|
||||
OP( POP); /* Pop original */
|
||||
} else {
|
||||
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) {
|
||||
goto genericReplace;
|
||||
}
|
||||
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) {
|
||||
goto genericReplace;
|
||||
}
|
||||
|
||||
/*
|
||||
* We handle these replacements specially: first character (where
|
||||
* idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
|
||||
* else and the semantics get rather screwy.
|
||||
*/
|
||||
|
||||
if (idx1 == 0 && idx2 == 0) {
|
||||
int notEq, end;
|
||||
|
||||
/*
|
||||
* Just working with the first character.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 1);
|
||||
if (replacementTokenPtr == NULL) {
|
||||
/* Drop first */
|
||||
OP44( STR_RANGE_IMM, 1, INDEX_END);
|
||||
return TCL_OK;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if ((last == TCL_INDEX_AFTER) && (first <= TCL_INDEX_END)) {
|
||||
OP44( STR_RANGE_IMM, 0, first-1);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
/* Replace first */
|
||||
CompileWord(envPtr, replacementTokenPtr, interp, 4);
|
||||
OP4( OVER, 1);
|
||||
PUSH( "");
|
||||
OP( STR_EQ);
|
||||
JUMP1( JUMP_FALSE, notEq);
|
||||
OP( POP);
|
||||
JUMP1( JUMP, end);
|
||||
FIXJUMP1(notEq);
|
||||
TclAdjustStackDepth(1, envPtr);
|
||||
OP4( REVERSE, 2);
|
||||
OP44( STR_RANGE_IMM, 1, INDEX_END);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
FIXJUMP1(end);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/* FLOW THROUGH TO genericReplace */
|
||||
} else if (idx1 == INDEX_END && idx2 == INDEX_END) {
|
||||
int notEq, end;
|
||||
|
||||
/*
|
||||
* Just working with the last character.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 1);
|
||||
if (replacementTokenPtr == NULL) {
|
||||
/* Drop last */
|
||||
OP44( STR_RANGE_IMM, 0, INDEX_END-1);
|
||||
return TCL_OK;
|
||||
}
|
||||
/* Replace last */
|
||||
CompileWord(envPtr, replacementTokenPtr, interp, 4);
|
||||
OP4( OVER, 1);
|
||||
PUSH( "");
|
||||
OP( STR_EQ);
|
||||
JUMP1( JUMP_FALSE, notEq);
|
||||
OP( POP);
|
||||
JUMP1( JUMP, end);
|
||||
FIXJUMP1(notEq);
|
||||
TclAdjustStackDepth(1, envPtr);
|
||||
OP4( REVERSE, 2);
|
||||
OP44( STR_RANGE_IMM, 0, INDEX_END-1);
|
||||
OP4( REVERSE, 2);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
FIXJUMP1(end);
|
||||
return TCL_OK;
|
||||
|
||||
} else {
|
||||
/*
|
||||
* When we have no replacement string to worry about, we may
|
||||
* have more luck, because the forbidden empty string replacements
|
||||
* are harmless when they are replaced by another empty string.
|
||||
/*
|
||||
* Need to process indices at runtime. This could be because the
|
||||
* indices are not constants, or because we need to resolve them to
|
||||
* absolute indices to work out if a replacement is going to happen.
|
||||
* In any case, to runtime it is.
|
||||
*/
|
||||
|
||||
if ((first == TCL_INDEX_BEFORE) || (first == TCL_INDEX_START)) {
|
||||
/* empty prefix - build suffix only */
|
||||
|
||||
if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
|
||||
/* empty suffix too => empty result */
|
||||
OP( POP); /* Pop original */
|
||||
PUSH ( "");
|
||||
return TCL_OK;
|
||||
}
|
||||
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
|
||||
return TCL_OK;
|
||||
} else {
|
||||
if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
|
||||
/* empty suffix - build prefix only */
|
||||
OP44( STR_RANGE_IMM, 0, first-1);
|
||||
return TCL_OK;
|
||||
}
|
||||
OP( DUP);
|
||||
OP44( STR_RANGE_IMM, 0, first-1);
|
||||
OP4( REVERSE, 2);
|
||||
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
|
||||
OP1( STR_CONCAT1, 2);
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
genericReplace:
|
||||
CompileWord(envPtr, valueTokenPtr, interp, 1);
|
||||
tokenPtr = TokenAfter(valueTokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 3);
|
||||
if (parsePtr->numWords == 5) {
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 4);
|
||||
if (replacementTokenPtr != NULL) {
|
||||
CompileWord(envPtr, replacementTokenPtr, interp, 4);
|
||||
} else {
|
||||
PUSH( "");
|
||||
}
|
||||
OP( STR_REPLACE);
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
int
|
||||
|
||||
@@ -1885,7 +1885,7 @@ ParseLexeme(
|
||||
{
|
||||
const char *end;
|
||||
int scanned;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
Tcl_Obj *literal = NULL;
|
||||
unsigned char byte;
|
||||
|
||||
@@ -2064,13 +2064,13 @@ ParseLexeme(
|
||||
|
||||
if (!TclIsBareword(*start) || *start == '_') {
|
||||
if (Tcl_UtfCharComplete(start, numBytes)) {
|
||||
scanned = TclUtfToUniChar(start, &ch);
|
||||
scanned = Tcl_UtfToUniChar(start, &ch);
|
||||
} else {
|
||||
char utfBytes[TCL_UTF_MAX];
|
||||
|
||||
memcpy(utfBytes, start, (size_t) numBytes);
|
||||
utfBytes[numBytes] = '\0';
|
||||
scanned = TclUtfToUniChar(utfBytes, &ch);
|
||||
scanned = Tcl_UtfToUniChar(utfBytes, &ch);
|
||||
}
|
||||
*lexemePtr = INVALID;
|
||||
Tcl_DecrRefCount(literal);
|
||||
|
||||
@@ -654,11 +654,6 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
/* Lappend list to general variable.
|
||||
* Stack: ... varName list => ... listVarContents */
|
||||
|
||||
{"clockRead", 2, +1, 1, {OPERAND_UINT1}},
|
||||
/* Read clock out to the stack. Operand is which clock to read
|
||||
* 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
|
||||
* Stack: ... => ... time */
|
||||
|
||||
{NULL, 0, 0, 0, {OPERAND_NONE}}
|
||||
};
|
||||
|
||||
|
||||
+15
-19
@@ -425,11 +425,11 @@ typedef struct ByteCode {
|
||||
* compiled. If the code is executed if a
|
||||
* different namespace, it must be
|
||||
* recompiled. */
|
||||
unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this
|
||||
int nsEpoch; /* Value of nsPtr->resolverEpoch when this
|
||||
* ByteCode was compiled. Used to invalidate
|
||||
* code when new namespace resolution rules
|
||||
* are put into effect. */
|
||||
unsigned int refCount; /* Reference count: set 1 when created plus 1
|
||||
int refCount; /* Reference count: set 1 when created plus 1
|
||||
* for each execution of the code currently
|
||||
* active. This structure can be freed when
|
||||
* refCount becomes zero. */
|
||||
@@ -821,10 +821,8 @@ typedef struct ByteCode {
|
||||
#define INST_LAPPEND_LIST_ARRAY_STK 187
|
||||
#define INST_LAPPEND_LIST_STK 188
|
||||
|
||||
#define INST_CLOCK_READ 189
|
||||
|
||||
/* The last opcode */
|
||||
#define LAST_INST_OPCODE 189
|
||||
#define LAST_INST_OPCODE 188
|
||||
|
||||
/*
|
||||
* Table describing the Tcl bytecode instructions: their name (for displaying
|
||||
@@ -1120,8 +1118,6 @@ MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
|
||||
int distThreshold);
|
||||
MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
|
||||
MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
|
||||
MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr,
|
||||
int before, int after, int *indexPtr);
|
||||
MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr);
|
||||
MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr,
|
||||
const Tcl_ObjType *typePtr, CompileEnv *envPtr);
|
||||
@@ -1242,10 +1238,10 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
|
||||
|
||||
#define TclCheckStackDepth(depth, envPtr) \
|
||||
do { \
|
||||
int _dd = (depth); \
|
||||
if (_dd != (envPtr)->currStackDepth) { \
|
||||
int dd = (depth); \
|
||||
if (dd != (envPtr)->currStackDepth) { \
|
||||
Tcl_Panic("bad stack depth computations: is %i, should be %i", \
|
||||
(envPtr)->currStackDepth, _dd); \
|
||||
(envPtr)->currStackDepth, dd); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
@@ -1261,12 +1257,12 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
|
||||
|
||||
#define TclUpdateStackReqs(op, i, envPtr) \
|
||||
do { \
|
||||
int _delta = tclInstructionTable[(op)].stackEffect; \
|
||||
if (_delta) { \
|
||||
if (_delta == INT_MIN) { \
|
||||
_delta = 1 - (i); \
|
||||
int delta = tclInstructionTable[(op)].stackEffect; \
|
||||
if (delta) { \
|
||||
if (delta == INT_MIN) { \
|
||||
delta = 1 - (i); \
|
||||
} \
|
||||
TclAdjustStackDepth(_delta, envPtr); \
|
||||
TclAdjustStackDepth(delta, envPtr); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
@@ -1380,11 +1376,11 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
|
||||
|
||||
#define TclEmitPush(objIndex, envPtr) \
|
||||
do { \
|
||||
register int _objIndexCopy = (objIndex); \
|
||||
if (_objIndexCopy <= 255) { \
|
||||
TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \
|
||||
register int objIndexCopy = (objIndex); \
|
||||
if (objIndexCopy <= 255) { \
|
||||
TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
|
||||
} else { \
|
||||
TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \
|
||||
TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
|
||||
+134
-178
@@ -23,15 +23,6 @@
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(BUILD_tcl)
|
||||
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
|
||||
#elif defined(TCL_NO_DEPRECATED)
|
||||
# define TCL_DEPRECATED(msg) MODULE_SCOPE
|
||||
#else
|
||||
# define TCL_DEPRECATED(msg) EXTERN
|
||||
#endif
|
||||
|
||||
|
||||
/*
|
||||
* WARNING: This file is automatically generated by the tools/genStubs.tcl
|
||||
* script. Any modifications to the function declarations below should be made
|
||||
@@ -53,7 +44,7 @@ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
const void *clientData);
|
||||
/* 1 */
|
||||
EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact, void *clientDataPtr);
|
||||
/* 2 */
|
||||
@@ -159,7 +150,8 @@ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, double *doublePtr);
|
||||
/* 36 */
|
||||
EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, const char *const *tablePtr,
|
||||
Tcl_Obj *objPtr,
|
||||
CONST84 char *const *tablePtr,
|
||||
const char *msg, int flags, int *indexPtr);
|
||||
/* 37 */
|
||||
EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src,
|
||||
@@ -262,8 +254,7 @@ EXTERN int Tcl_AsyncReady(void);
|
||||
/* 76 */
|
||||
EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
|
||||
/* 77 */
|
||||
TCL_DEPRECATED("Use Tcl_UtfBackslash")
|
||||
char Tcl_Backslash(const char *src, int *readPtr);
|
||||
EXTERN char Tcl_Backslash(const char *src, int *readPtr);
|
||||
/* 78 */
|
||||
EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
|
||||
const char *optionName,
|
||||
@@ -280,7 +271,7 @@ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
|
||||
/* 82 */
|
||||
EXTERN int Tcl_CommandComplete(const char *cmd);
|
||||
/* 83 */
|
||||
EXTERN char * Tcl_Concat(int argc, const char *const *argv);
|
||||
EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv);
|
||||
/* 84 */
|
||||
EXTERN int Tcl_ConvertElement(const char *src, char *dst,
|
||||
int flags);
|
||||
@@ -291,7 +282,7 @@ EXTERN int Tcl_ConvertCountedElement(const char *src,
|
||||
EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
|
||||
const char *slaveCmd, Tcl_Interp *target,
|
||||
const char *targetCmd, int argc,
|
||||
const char *const *argv);
|
||||
CONST84 char *const *argv);
|
||||
/* 87 */
|
||||
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
|
||||
const char *slaveCmd, Tcl_Interp *target,
|
||||
@@ -322,8 +313,7 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
|
||||
/* 94 */
|
||||
EXTERN Tcl_Interp * Tcl_CreateInterp(void);
|
||||
/* 95 */
|
||||
TCL_DEPRECATED("")
|
||||
void Tcl_CreateMathFunc(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp,
|
||||
const char *name, int numArgs,
|
||||
Tcl_ValueType *argTypes, Tcl_MathProc *proc,
|
||||
ClientData clientData);
|
||||
@@ -413,9 +403,9 @@ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr);
|
||||
/* 126 */
|
||||
EXTERN int Tcl_Eof(Tcl_Channel chan);
|
||||
/* 127 */
|
||||
EXTERN const char * Tcl_ErrnoId(void);
|
||||
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
|
||||
/* 128 */
|
||||
EXTERN const char * Tcl_ErrnoMsg(int err);
|
||||
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
|
||||
/* 129 */
|
||||
EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
|
||||
/* 130 */
|
||||
@@ -470,13 +460,13 @@ EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
|
||||
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
|
||||
const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr,
|
||||
const char **targetCmdPtr, int *argcPtr,
|
||||
const char ***argvPtr);
|
||||
CONST84 char **targetCmdPtr, int *argcPtr,
|
||||
CONST84 char ***argvPtr);
|
||||
/* 149 */
|
||||
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
|
||||
const char *slaveCmd,
|
||||
Tcl_Interp **targetInterpPtr,
|
||||
const char **targetCmdPtr, int *objcPtr,
|
||||
CONST84 char **targetCmdPtr, int *objcPtr,
|
||||
Tcl_Obj ***objv);
|
||||
/* 150 */
|
||||
EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp,
|
||||
@@ -495,7 +485,7 @@ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan);
|
||||
/* 155 */
|
||||
EXTERN int Tcl_GetChannelMode(Tcl_Channel chan);
|
||||
/* 156 */
|
||||
EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
|
||||
/* 157 */
|
||||
EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
|
||||
Tcl_Channel chan, const char *optionName,
|
||||
@@ -506,12 +496,12 @@ EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
|
||||
EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_CmdInfo *infoPtr);
|
||||
/* 160 */
|
||||
EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
|
||||
Tcl_Command command);
|
||||
/* 161 */
|
||||
EXTERN int Tcl_GetErrno(void);
|
||||
/* 162 */
|
||||
EXTERN const char * Tcl_GetHostName(void);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
|
||||
/* 163 */
|
||||
EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp,
|
||||
Tcl_Interp *slaveInterp);
|
||||
@@ -547,13 +537,14 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
|
||||
/* 173 */
|
||||
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
|
||||
/* 174 */
|
||||
EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
|
||||
/* 175 */
|
||||
EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
|
||||
const char *varName, int flags);
|
||||
/* 176 */
|
||||
EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, int flags);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
|
||||
const char *part1, const char *part2,
|
||||
int flags);
|
||||
/* 177 */
|
||||
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
|
||||
const char *command);
|
||||
@@ -578,7 +569,7 @@ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp);
|
||||
/* 185 */
|
||||
EXTERN int Tcl_IsSafe(Tcl_Interp *interp);
|
||||
/* 186 */
|
||||
EXTERN char * Tcl_JoinPath(int argc, const char *const *argv,
|
||||
EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv,
|
||||
Tcl_DString *resultPtr);
|
||||
/* 187 */
|
||||
EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
|
||||
@@ -591,7 +582,7 @@ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp);
|
||||
/* 191 */
|
||||
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket);
|
||||
/* 192 */
|
||||
EXTERN char * Tcl_Merge(int argc, const char *const *argv);
|
||||
EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv);
|
||||
/* 193 */
|
||||
EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
|
||||
/* 194 */
|
||||
@@ -605,7 +596,7 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
|
||||
int flags);
|
||||
/* 197 */
|
||||
EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
|
||||
const char **argv, int flags);
|
||||
CONST84 char **argv, int flags);
|
||||
/* 198 */
|
||||
EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp,
|
||||
const char *fileName, const char *modeString,
|
||||
@@ -627,7 +618,7 @@ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value,
|
||||
/* 203 */
|
||||
EXTERN int Tcl_PutEnv(const char *assignment);
|
||||
/* 204 */
|
||||
EXTERN const char * Tcl_PosixError(Tcl_Interp *interp);
|
||||
EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
|
||||
/* 205 */
|
||||
EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr,
|
||||
Tcl_QueuePosition position);
|
||||
@@ -657,7 +648,8 @@ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
|
||||
const char *pattern);
|
||||
/* 215 */
|
||||
EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
|
||||
const char **startPtr, const char **endPtr);
|
||||
CONST84 char **startPtr,
|
||||
CONST84 char **endPtr);
|
||||
/* 216 */
|
||||
EXTERN void Tcl_Release(ClientData clientData);
|
||||
/* 217 */
|
||||
@@ -668,8 +660,7 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
|
||||
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
|
||||
int *flagPtr);
|
||||
/* 220 */
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
|
||||
EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
|
||||
/* 221 */
|
||||
EXTERN int Tcl_ServiceAll(void);
|
||||
/* 222 */
|
||||
@@ -713,25 +704,26 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp,
|
||||
/* 236 */
|
||||
EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type);
|
||||
/* 237 */
|
||||
EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
|
||||
const char *newValue, int flags);
|
||||
/* 238 */
|
||||
EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, const char *newValue,
|
||||
EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
|
||||
const char *varName, const char *newValue,
|
||||
int flags);
|
||||
/* 238 */
|
||||
EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
|
||||
const char *part1, const char *part2,
|
||||
const char *newValue, int flags);
|
||||
/* 239 */
|
||||
EXTERN const char * Tcl_SignalId(int sig);
|
||||
EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
|
||||
/* 240 */
|
||||
EXTERN const char * Tcl_SignalMsg(int sig);
|
||||
EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
|
||||
/* 241 */
|
||||
EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp);
|
||||
/* 242 */
|
||||
EXTERN int Tcl_SplitList(Tcl_Interp *interp,
|
||||
const char *listStr, int *argcPtr,
|
||||
const char ***argvPtr);
|
||||
CONST84 char ***argvPtr);
|
||||
/* 243 */
|
||||
EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
|
||||
const char ***argvPtr);
|
||||
CONST84 char ***argvPtr);
|
||||
/* 244 */
|
||||
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
|
||||
const char *pkgName,
|
||||
@@ -740,8 +732,7 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
|
||||
/* 245 */
|
||||
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
|
||||
/* 246 */
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_TellOld(Tcl_Channel chan);
|
||||
EXTERN int Tcl_TellOld(Tcl_Channel chan);
|
||||
/* 247 */
|
||||
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags, Tcl_VarTraceProc *proc,
|
||||
@@ -812,43 +803,40 @@ EXTERN int Tcl_DumpActiveMemory(const char *fileName);
|
||||
/* 266 */
|
||||
EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
|
||||
/* 267 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
void Tcl_AppendResultVA(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp,
|
||||
va_list argList);
|
||||
/* 268 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
|
||||
EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
|
||||
va_list argList);
|
||||
/* 269 */
|
||||
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
|
||||
/* 270 */
|
||||
EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
|
||||
const char **termPtr);
|
||||
EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
|
||||
const char *start, CONST84 char **termPtr);
|
||||
/* 271 */
|
||||
EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact);
|
||||
/* 272 */
|
||||
EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact, void *clientDataPtr);
|
||||
/* 273 */
|
||||
EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
|
||||
const char *version);
|
||||
/* 274 */
|
||||
EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
|
||||
const char *name, const char *version,
|
||||
int exact);
|
||||
/* 275 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
|
||||
va_list argList);
|
||||
/* 276 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
|
||||
EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
|
||||
/* 277 */
|
||||
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
|
||||
/* 278 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
|
||||
EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
|
||||
/* 279 */
|
||||
EXTERN void Tcl_GetVersion(int *major, int *minor,
|
||||
int *patchLevel, int *type);
|
||||
@@ -890,7 +878,7 @@ EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc,
|
||||
EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int flags);
|
||||
/* 294 */
|
||||
EXTERN TCL_NORETURN void Tcl_ExitThread(int status);
|
||||
EXTERN void Tcl_ExitThread(int status);
|
||||
/* 295 */
|
||||
EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp,
|
||||
Tcl_Encoding encoding, const char *src,
|
||||
@@ -913,7 +901,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void);
|
||||
/* 301 */
|
||||
EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
|
||||
/* 302 */
|
||||
EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
|
||||
/* 303 */
|
||||
EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp);
|
||||
/* 304 */
|
||||
@@ -972,20 +960,20 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch);
|
||||
/* 324 */
|
||||
EXTERN int Tcl_UniCharToUtf(int ch, char *buf);
|
||||
/* 325 */
|
||||
EXTERN const char * Tcl_UtfAtIndex(const char *src, int index);
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
|
||||
/* 326 */
|
||||
EXTERN int Tcl_UtfCharComplete(const char *src, int length);
|
||||
/* 327 */
|
||||
EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr,
|
||||
char *dst);
|
||||
/* 328 */
|
||||
EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch);
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
|
||||
/* 329 */
|
||||
EXTERN const char * Tcl_UtfFindLast(const char *src, int ch);
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
|
||||
/* 330 */
|
||||
EXTERN const char * Tcl_UtfNext(const char *src);
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
|
||||
/* 331 */
|
||||
EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
|
||||
EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
|
||||
/* 332 */
|
||||
EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp,
|
||||
Tcl_Encoding encoding, const char *src,
|
||||
@@ -1013,11 +1001,9 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
|
||||
/* 340 */
|
||||
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
|
||||
/* 341 */
|
||||
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
|
||||
const char * Tcl_GetDefaultEncodingDir(void);
|
||||
EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
|
||||
/* 342 */
|
||||
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
|
||||
void Tcl_SetDefaultEncodingDir(const char *path);
|
||||
EXTERN void Tcl_SetDefaultEncodingDir(const char *path);
|
||||
/* 343 */
|
||||
EXTERN void Tcl_AlertNotifier(ClientData clientData);
|
||||
/* 344 */
|
||||
@@ -1052,8 +1038,7 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
|
||||
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *patObj, int flags);
|
||||
/* 357 */
|
||||
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
|
||||
Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
|
||||
EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
|
||||
Tcl_Token *tokenPtr, int count);
|
||||
/* 358 */
|
||||
EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
|
||||
@@ -1065,7 +1050,7 @@ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_ParseBraces(Tcl_Interp *interp,
|
||||
const char *start, int numBytes,
|
||||
Tcl_Parse *parsePtr, int append,
|
||||
const char **termPtr);
|
||||
CONST84 char **termPtr);
|
||||
/* 361 */
|
||||
EXTERN int Tcl_ParseCommand(Tcl_Interp *interp,
|
||||
const char *start, int numBytes, int nested,
|
||||
@@ -1077,7 +1062,7 @@ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
|
||||
EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp,
|
||||
const char *start, int numBytes,
|
||||
Tcl_Parse *parsePtr, int append,
|
||||
const char **termPtr);
|
||||
CONST84 char **termPtr);
|
||||
/* 364 */
|
||||
EXTERN int Tcl_ParseVarName(Tcl_Interp *interp,
|
||||
const char *start, int numBytes,
|
||||
@@ -1167,7 +1152,8 @@ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan);
|
||||
/* 397 */
|
||||
EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan);
|
||||
/* 398 */
|
||||
EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
|
||||
EXTERN CONST84_RETURN char * Tcl_ChannelName(
|
||||
const Tcl_ChannelType *chanTypePtr);
|
||||
/* 399 */
|
||||
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
|
||||
const Tcl_ChannelType *chanTypePtr);
|
||||
@@ -1273,15 +1259,13 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
|
||||
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
|
||||
int *lengthPtr);
|
||||
/* 435 */
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
|
||||
const char *name, int *numArgsPtr,
|
||||
Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr,
|
||||
ClientData *clientDataPtr);
|
||||
/* 436 */
|
||||
TCL_DEPRECATED("")
|
||||
Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
|
||||
EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
|
||||
const char *pattern);
|
||||
/* 437 */
|
||||
EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
@@ -1850,7 +1834,7 @@ typedef struct TclStubs {
|
||||
const TclStubHooks *hooks;
|
||||
|
||||
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
|
||||
const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
|
||||
CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
|
||||
TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
|
||||
char * (*tcl_Alloc) (unsigned int size); /* 3 */
|
||||
void (*tcl_Free) (char *ptr); /* 4 */
|
||||
@@ -1901,7 +1885,7 @@ typedef struct TclStubs {
|
||||
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
|
||||
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
|
||||
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
|
||||
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
|
||||
int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
|
||||
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
|
||||
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
|
||||
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
|
||||
@@ -1942,16 +1926,16 @@ typedef struct TclStubs {
|
||||
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
|
||||
int (*tcl_AsyncReady) (void); /* 75 */
|
||||
void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
|
||||
TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
|
||||
char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
|
||||
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
|
||||
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
|
||||
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
|
||||
int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
|
||||
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
|
||||
char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
|
||||
char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
|
||||
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
|
||||
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
|
||||
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
|
||||
int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
|
||||
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
|
||||
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
|
||||
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
|
||||
@@ -1960,7 +1944,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
|
||||
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
|
||||
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
|
||||
TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
|
||||
void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
|
||||
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
|
||||
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
|
||||
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
|
||||
@@ -1992,8 +1976,8 @@ typedef struct TclStubs {
|
||||
void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
|
||||
void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
|
||||
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
|
||||
const char * (*tcl_ErrnoId) (void); /* 127 */
|
||||
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
|
||||
CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
|
||||
CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
|
||||
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
|
||||
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
|
||||
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
|
||||
@@ -2013,21 +1997,21 @@ typedef struct TclStubs {
|
||||
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
|
||||
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
|
||||
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
|
||||
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
|
||||
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
|
||||
int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
|
||||
int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
|
||||
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
|
||||
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
|
||||
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
|
||||
int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
|
||||
ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
|
||||
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
|
||||
const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
|
||||
CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
|
||||
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
|
||||
CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
|
||||
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
|
||||
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
|
||||
CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
|
||||
int (*tcl_GetErrno) (void); /* 161 */
|
||||
const char * (*tcl_GetHostName) (void); /* 162 */
|
||||
CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
|
||||
int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
|
||||
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
|
||||
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
|
||||
@@ -2047,9 +2031,9 @@ typedef struct TclStubs {
|
||||
int (*tcl_GetServiceMode) (void); /* 171 */
|
||||
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
|
||||
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
|
||||
const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
|
||||
const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
|
||||
CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
|
||||
CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
|
||||
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
|
||||
int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
|
||||
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
|
||||
@@ -2059,25 +2043,25 @@ typedef struct TclStubs {
|
||||
int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
|
||||
int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
|
||||
int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
|
||||
char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
|
||||
char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */
|
||||
int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
|
||||
void (*reserved188)(void);
|
||||
Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
|
||||
int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
|
||||
Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
|
||||
char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
|
||||
char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */
|
||||
Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
|
||||
void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
|
||||
Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
|
||||
Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
|
||||
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
|
||||
Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
|
||||
Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
|
||||
Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
|
||||
Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
|
||||
void (*tcl_Preserve) (ClientData data); /* 201 */
|
||||
void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
|
||||
int (*tcl_PutEnv) (const char *assignment); /* 203 */
|
||||
const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
|
||||
CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
|
||||
void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
|
||||
int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
|
||||
void (*tcl_ReapDetachedProcs) (void); /* 207 */
|
||||
@@ -2088,12 +2072,12 @@ typedef struct TclStubs {
|
||||
Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
|
||||
int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
|
||||
int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
|
||||
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
|
||||
void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
|
||||
void (*tcl_Release) (ClientData clientData); /* 216 */
|
||||
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
|
||||
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
|
||||
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
|
||||
TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
|
||||
int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
|
||||
int (*tcl_ServiceAll) (void); /* 221 */
|
||||
int (*tcl_ServiceEvent) (int flags); /* 222 */
|
||||
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
|
||||
@@ -2110,16 +2094,16 @@ typedef struct TclStubs {
|
||||
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
|
||||
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
|
||||
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
|
||||
const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
|
||||
const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
|
||||
const char * (*tcl_SignalId) (int sig); /* 239 */
|
||||
const char * (*tcl_SignalMsg) (int sig); /* 240 */
|
||||
CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
|
||||
CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
|
||||
CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
|
||||
CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
|
||||
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
|
||||
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
|
||||
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
|
||||
int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
|
||||
void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
|
||||
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
|
||||
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
|
||||
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
|
||||
int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
|
||||
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
|
||||
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
|
||||
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
|
||||
@@ -2140,18 +2124,18 @@ typedef struct TclStubs {
|
||||
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
|
||||
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
|
||||
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
|
||||
void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
|
||||
void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
|
||||
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
|
||||
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
|
||||
const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
|
||||
CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
|
||||
CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
|
||||
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
|
||||
const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
|
||||
TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
|
||||
CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
|
||||
int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
|
||||
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
|
||||
TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
|
||||
TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
|
||||
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
|
||||
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
|
||||
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
|
||||
@@ -2167,7 +2151,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */
|
||||
int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
|
||||
int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
|
||||
TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */
|
||||
void (*tcl_ExitThread) (int status); /* 294 */
|
||||
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); /* 295 */
|
||||
char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
|
||||
void (*tcl_FinalizeThread) (void); /* 297 */
|
||||
@@ -2175,7 +2159,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
|
||||
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
|
||||
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
|
||||
const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
|
||||
CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
|
||||
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
|
||||
int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
|
||||
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
|
||||
@@ -2198,13 +2182,13 @@ typedef struct TclStubs {
|
||||
Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
|
||||
Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
|
||||
int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
|
||||
const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
|
||||
CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
|
||||
int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
|
||||
int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
|
||||
const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
|
||||
const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
|
||||
const char * (*tcl_UtfNext) (const char *src); /* 330 */
|
||||
const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
|
||||
CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
|
||||
CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
|
||||
CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */
|
||||
CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
|
||||
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); /* 332 */
|
||||
char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
|
||||
int (*tcl_UtfToLower) (char *src); /* 334 */
|
||||
@@ -2214,8 +2198,8 @@ typedef struct TclStubs {
|
||||
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
|
||||
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
|
||||
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
|
||||
TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
|
||||
TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
|
||||
CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
|
||||
void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
|
||||
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
|
||||
void (*tcl_ServiceModeHook) (int mode); /* 344 */
|
||||
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
|
||||
@@ -2230,13 +2214,13 @@ typedef struct TclStubs {
|
||||
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
|
||||
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
|
||||
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
|
||||
TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
|
||||
Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
|
||||
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
|
||||
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
|
||||
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
|
||||
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
|
||||
int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
|
||||
int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
|
||||
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
|
||||
int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
|
||||
int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
|
||||
char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
|
||||
int (*tcl_Chdir) (const char *dirName); /* 366 */
|
||||
@@ -2271,7 +2255,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
|
||||
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
|
||||
int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
|
||||
const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
|
||||
CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
|
||||
Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
|
||||
Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
|
||||
Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
|
||||
@@ -2308,8 +2292,8 @@ typedef struct TclStubs {
|
||||
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
|
||||
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
|
||||
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
|
||||
TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
|
||||
TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
|
||||
int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
|
||||
Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
|
||||
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
|
||||
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
|
||||
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
|
||||
@@ -3851,13 +3835,13 @@ extern const TclStubs *tclStubsPtr;
|
||||
sizeof(char *), msg, flags, indexPtr)
|
||||
#undef Tcl_NewBooleanObj
|
||||
#define Tcl_NewBooleanObj(boolValue) \
|
||||
Tcl_NewLongObj((boolValue)!=0)
|
||||
Tcl_NewIntObj((boolValue)!=0)
|
||||
#undef Tcl_DbNewBooleanObj
|
||||
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
|
||||
Tcl_DbNewLongObj((boolValue)!=0, file, line)
|
||||
#undef Tcl_SetBooleanObj
|
||||
#define Tcl_SetBooleanObj(objPtr, boolValue) \
|
||||
Tcl_SetLongObj(objPtr, (boolValue)!=0)
|
||||
Tcl_SetIntObj((objPtr), (boolValue)!=0)
|
||||
#undef Tcl_SetVar
|
||||
#define Tcl_SetVar(interp, varName, newValue, flags) \
|
||||
Tcl_SetVar2(interp, varName, NULL, newValue, flags)
|
||||
@@ -3886,29 +3870,6 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_AddObjErrorInfo(interp, message, length) \
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
#undef Tcl_Eval
|
||||
#define Tcl_Eval(interp, objPtr) \
|
||||
Tcl_EvalEx(interp, objPtr, -1, 0)
|
||||
#undef Tcl_GlobalEval
|
||||
#define Tcl_GlobalEval(interp, objPtr) \
|
||||
Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
|
||||
#undef Tcl_SaveResult
|
||||
#define Tcl_SaveResult(interp, statePtr) \
|
||||
do { \
|
||||
(statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
|
||||
Tcl_IncrRefCount((statePtr)->objResultPtr); \
|
||||
Tcl_SetObjResult(interp, Tcl_NewObj()); \
|
||||
} while(0)
|
||||
#undef Tcl_RestoreResult
|
||||
#define Tcl_RestoreResult(interp, statePtr) \
|
||||
do { \
|
||||
Tcl_ResetResult(interp); \
|
||||
Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
|
||||
Tcl_DecrRefCount((statePtr)->objResultPtr); \
|
||||
} while(0)
|
||||
#undef Tcl_DiscardResult
|
||||
#define Tcl_DiscardResult(statePtr) \
|
||||
Tcl_DecrRefCount((statePtr)->objResultPtr)
|
||||
#undef Tcl_SetResult
|
||||
#define Tcl_SetResult(interp, result, freeProc) \
|
||||
do { \
|
||||
@@ -3934,14 +3895,20 @@ extern const TclStubs *tclStubsPtr;
|
||||
* possible. Tcl 9 must find a better solution, but that cannot be done
|
||||
* without introducing a binary incompatibility.
|
||||
*/
|
||||
# undef Tcl_DbNewLongObj
|
||||
# undef Tcl_GetLongFromObj
|
||||
# undef Tcl_NewLongObj
|
||||
# undef Tcl_SetLongObj
|
||||
# undef Tcl_ExprLong
|
||||
# undef Tcl_ExprLongObj
|
||||
# undef Tcl_UniCharNcmp
|
||||
# undef Tcl_UtfNcmp
|
||||
# undef Tcl_UtfNcasecmp
|
||||
# undef Tcl_UniCharNcasecmp
|
||||
# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
|
||||
# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
|
||||
# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
|
||||
# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
|
||||
# define Tcl_ExprLong TclExprLong
|
||||
static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
|
||||
int intValue;
|
||||
@@ -3967,26 +3934,15 @@ extern const TclStubs *tclStubsPtr;
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#undef Tcl_NewLongObj
|
||||
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
|
||||
#undef Tcl_NewIntObj
|
||||
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
|
||||
#undef Tcl_DbNewLongObj
|
||||
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
|
||||
#undef Tcl_SetIntObj
|
||||
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value))
|
||||
#undef Tcl_SetLongObj
|
||||
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value))
|
||||
|
||||
/*
|
||||
* Deprecated Tcl procedures:
|
||||
*/
|
||||
|
||||
#undef Tcl_EvalObj
|
||||
#define Tcl_EvalObj(interp, objPtr) \
|
||||
Tcl_EvalObjEx(interp, objPtr, 0)
|
||||
#define Tcl_EvalObj(interp,objPtr) \
|
||||
Tcl_EvalObjEx((interp),(objPtr),0)
|
||||
#undef Tcl_GlobalEvalObj
|
||||
#define Tcl_GlobalEvalObj(interp, objPtr) \
|
||||
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
|
||||
#define Tcl_GlobalEvalObj(interp,objPtr) \
|
||||
Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
|
||||
|
||||
#endif /* _TCLDECLS */
|
||||
|
||||
+21
-23
@@ -141,7 +141,7 @@ typedef struct Dict {
|
||||
* the dictionary. Used for doing traversal of
|
||||
* the entries in the order that they are
|
||||
* created. */
|
||||
unsigned int epoch; /* Epoch counter */
|
||||
int epoch; /* Epoch counter */
|
||||
size_t refCount; /* Reference counter (see above) */
|
||||
Tcl_Obj *chain; /* Linked list used for invalidating the
|
||||
* string representations of updated nested
|
||||
@@ -390,7 +390,7 @@ DupDictInternalRep(
|
||||
* Initialise other fields.
|
||||
*/
|
||||
|
||||
newDict->epoch = 1;
|
||||
newDict->epoch = 0;
|
||||
newDict->chain = NULL;
|
||||
newDict->refCount = 1;
|
||||
|
||||
@@ -487,14 +487,15 @@ static void
|
||||
UpdateStringOfDict(
|
||||
Tcl_Obj *dictPtr)
|
||||
{
|
||||
#define LOCAL_SIZE 64
|
||||
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
#define LOCAL_SIZE 20
|
||||
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
Dict *dict = DICT(dictPtr);
|
||||
ChainEntry *cPtr;
|
||||
Tcl_Obj *keyPtr, *valuePtr;
|
||||
int i, length, bytesNeeded = 0;
|
||||
const char *elem;
|
||||
char *dst;
|
||||
const int maxFlags = UINT_MAX / sizeof(int);
|
||||
|
||||
/*
|
||||
* This field is the most useful one in the whole hash structure, and it
|
||||
@@ -516,8 +517,10 @@ UpdateStringOfDict(
|
||||
|
||||
if (numElems <= LOCAL_SIZE) {
|
||||
flagPtr = localFlags;
|
||||
} else if (numElems > maxFlags) {
|
||||
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
|
||||
} else {
|
||||
flagPtr = ckalloc(numElems);
|
||||
flagPtr = ckalloc(numElems * sizeof(int));
|
||||
}
|
||||
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
|
||||
/*
|
||||
@@ -707,7 +710,7 @@ SetDictFromAny(
|
||||
*/
|
||||
|
||||
TclFreeIntRep(objPtr);
|
||||
dict->epoch = 1;
|
||||
dict->epoch = 0;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DICT(objPtr) = dict;
|
||||
@@ -1106,7 +1109,7 @@ Tcl_DictObjFirst(
|
||||
dict = DICT(dictPtr);
|
||||
cPtr = dict->entryChainHead;
|
||||
if (cPtr == NULL) {
|
||||
searchPtr->epoch = 0;
|
||||
searchPtr->epoch = -1;
|
||||
*donePtr = 1;
|
||||
} else {
|
||||
*donePtr = 0;
|
||||
@@ -1167,7 +1170,7 @@ Tcl_DictObjNext(
|
||||
* If the searh is done; we do no work.
|
||||
*/
|
||||
|
||||
if (!searchPtr->epoch) {
|
||||
if (searchPtr->epoch == -1) {
|
||||
*donePtr = 1;
|
||||
return;
|
||||
}
|
||||
@@ -1224,8 +1227,8 @@ Tcl_DictObjDone(
|
||||
{
|
||||
Dict *dict;
|
||||
|
||||
if (searchPtr->epoch) {
|
||||
searchPtr->epoch = 0;
|
||||
if (searchPtr->epoch != -1) {
|
||||
searchPtr->epoch = -1;
|
||||
dict = (Dict *) searchPtr->dictionaryPtr;
|
||||
if (dict->refCount-- <= 1) {
|
||||
DeleteDict(dict);
|
||||
@@ -1377,7 +1380,7 @@ Tcl_NewDictObj(void)
|
||||
TclInvalidateStringRep(dictPtr);
|
||||
dict = ckalloc(sizeof(Dict));
|
||||
InitChainTable(dict);
|
||||
dict->epoch = 1;
|
||||
dict->epoch = 0;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DICT(dictPtr) = dict;
|
||||
@@ -1427,7 +1430,7 @@ Tcl_DbNewDictObj(
|
||||
TclInvalidateStringRep(dictPtr);
|
||||
dict = ckalloc(sizeof(Dict));
|
||||
InitChainTable(dict);
|
||||
dict->epoch = 1;
|
||||
dict->epoch = 0;
|
||||
dict->chain = NULL;
|
||||
dict->refCount = 1;
|
||||
DICT(dictPtr) = dict;
|
||||
@@ -2309,12 +2312,9 @@ DictAppendCmd(
|
||||
|
||||
if (objc == 4) {
|
||||
appendObjPtr = objv[3];
|
||||
} else {
|
||||
appendObjPtr = TclStringCat(interp, objc-3, objv+3,
|
||||
TCL_STRING_IN_PLACE);
|
||||
if (appendObjPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else if (TCL_OK != TclStringCatObjv(interp, /* inPlace */ 1,
|
||||
objc-3, objv+3, &appendObjPtr)) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2331,9 +2331,7 @@ DictAppendCmd(
|
||||
valuePtr = Tcl_DuplicateObj(valuePtr);
|
||||
}
|
||||
|
||||
Tcl_IncrRefCount(appendObjPtr);
|
||||
Tcl_AppendObjToObj(valuePtr, appendObjPtr);
|
||||
Tcl_DecrRefCount(appendObjPtr);
|
||||
}
|
||||
|
||||
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
|
||||
@@ -3564,7 +3562,7 @@ TclDictWithFinish(
|
||||
* If the dictionary variable doesn't exist, drop everything silently.
|
||||
*/
|
||||
|
||||
dictPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
|
||||
dictPtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
|
||||
TCL_LEAVE_ERR_MSG, index);
|
||||
if (dictPtr == NULL) {
|
||||
return TCL_OK;
|
||||
@@ -3647,8 +3645,8 @@ TclDictWithFinish(
|
||||
* Write back the outermost dictionary to the variable.
|
||||
*/
|
||||
|
||||
if (TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
|
||||
dictPtr, TCL_LEAVE_ERR_MSG, index) == NULL) {
|
||||
if (TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, dictPtr,
|
||||
TCL_LEAVE_ERR_MSG, index) == NULL) {
|
||||
if (allocdict) {
|
||||
TclDecrRefCount(dictPtr);
|
||||
}
|
||||
|
||||
+34
-28
@@ -27,8 +27,9 @@ static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
static int FormatInstruction(ByteCode *codePtr,
|
||||
const unsigned char *pc, Tcl_Obj *bufferObj);
|
||||
static void GetLocationInformation(Proc *procPtr,
|
||||
Tcl_Obj **fileObjPtr, int *linePtr);
|
||||
static void GetLocationInformation(Tcl_Interp *interp,
|
||||
Proc *procPtr, Tcl_Obj **fileObjPtr,
|
||||
int *linePtr);
|
||||
static void PrintSourceToObj(Tcl_Obj *appendObj,
|
||||
const char *stringPtr, int maxChars);
|
||||
static void UpdateStringOfInstName(Tcl_Obj *objPtr);
|
||||
@@ -72,6 +73,8 @@ static const Tcl_ObjType tclInstNameType = {
|
||||
|
||||
static void
|
||||
GetLocationInformation(
|
||||
Tcl_Interp *interp, /* Where to look up the location
|
||||
* information. */
|
||||
Proc *procPtr, /* What to look up the information for. */
|
||||
Tcl_Obj **fileObjPtr, /* Where to write the information about what
|
||||
* file the code came from. Will be written
|
||||
@@ -85,21 +88,20 @@ GetLocationInformation(
|
||||
* either with the line number or with -1 if
|
||||
* the information is not available. */
|
||||
{
|
||||
CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr);
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Tcl_HashEntry *hePtr;
|
||||
CmdFrame *cfPtr;
|
||||
|
||||
*fileObjPtr = NULL;
|
||||
*linePtr = -1;
|
||||
if (cfPtr == NULL) {
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the source location data out of the CmdFrame.
|
||||
*/
|
||||
|
||||
*linePtr = cfPtr->line[0];
|
||||
if (cfPtr->type == TCL_LOCATION_SOURCE) {
|
||||
*fileObjPtr = cfPtr->data.eval.path;
|
||||
if (iPtr != NULL && procPtr != NULL) {
|
||||
hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
|
||||
if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
|
||||
*linePtr = cfPtr->line[0];
|
||||
if (cfPtr->type == TCL_LOCATION_SOURCE) {
|
||||
*fileObjPtr = cfPtr->data.eval.path;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -252,9 +254,10 @@ DisassembleByteCodeObj(
|
||||
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
|
||||
Interp *iPtr = (Interp *) *codePtr->interpHandle;
|
||||
Tcl_Obj *bufferObj, *fileObj;
|
||||
char ptrBuf1[20], ptrBuf2[20];
|
||||
|
||||
TclNewObj(bufferObj);
|
||||
if (!codePtr->refCount) {
|
||||
if (codePtr->refCount <= 0) {
|
||||
return bufferObj; /* Already freed. */
|
||||
}
|
||||
|
||||
@@ -266,14 +269,16 @@ DisassembleByteCodeObj(
|
||||
* Print header lines describing the ByteCode.
|
||||
*/
|
||||
|
||||
sprintf(ptrBuf1, "%p", codePtr);
|
||||
sprintf(ptrBuf2, "%p", iPtr);
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
"ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n",
|
||||
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
|
||||
"ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
|
||||
ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
|
||||
iPtr->compileEpoch);
|
||||
Tcl_AppendToObj(bufferObj, " Source ", -1);
|
||||
PrintSourceToObj(bufferObj, codePtr->source,
|
||||
TclMin(codePtr->numSrcBytes, 55));
|
||||
GetLocationInformation(codePtr->procPtr, &fileObj, &line);
|
||||
GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
|
||||
if (line > -1 && fileObj != NULL) {
|
||||
Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d",
|
||||
Tcl_GetString(fileObj), line);
|
||||
@@ -311,9 +316,10 @@ DisassembleByteCodeObj(
|
||||
Proc *procPtr = codePtr->procPtr;
|
||||
int numCompiledLocals = procPtr->numCompiledLocals;
|
||||
|
||||
sprintf(ptrBuf1, "%p", procPtr);
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
" Proc %p, refCt %u, args %d, compiled locals %d\n",
|
||||
procPtr, procPtr->refCount, procPtr->numArgs,
|
||||
" Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
|
||||
ptrBuf1, procPtr->refCount, procPtr->numArgs,
|
||||
numCompiledLocals);
|
||||
if (numCompiledLocals > 0) {
|
||||
CompiledLocal *localPtr = procPtr->firstLocalPtr;
|
||||
@@ -797,7 +803,7 @@ TclNewInstNameObj(
|
||||
Tcl_Obj *objPtr = Tcl_NewObj();
|
||||
|
||||
objPtr->typePtr = &tclInstNameType;
|
||||
objPtr->internalRep.wideValue = (long) inst;
|
||||
objPtr->internalRep.longValue = (long) inst;
|
||||
objPtr->bytes = NULL;
|
||||
|
||||
return objPtr;
|
||||
@@ -817,17 +823,17 @@ static void
|
||||
UpdateStringOfInstName(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
size_t len, inst = (size_t)objPtr->internalRep.wideValue;
|
||||
char *s, buf[TCL_INTEGER_SPACE + 5];
|
||||
int inst = objPtr->internalRep.longValue;
|
||||
char *s, buf[20];
|
||||
int len;
|
||||
|
||||
if (inst > LAST_INST_OPCODE) {
|
||||
sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
|
||||
if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
|
||||
sprintf(buf, "inst_%d", inst);
|
||||
s = buf;
|
||||
} else {
|
||||
s = (char *) tclInstructionTable[inst].name;
|
||||
s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
|
||||
}
|
||||
len = strlen(s);
|
||||
/* assert (len < UINT_MAX) */
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, s, len + 1);
|
||||
objPtr->length = len;
|
||||
@@ -1215,7 +1221,7 @@ DisassembleByteCodeAsDicts(
|
||||
* system if it is available.
|
||||
*/
|
||||
|
||||
GetLocationInformation(codePtr->procPtr, &file, &line);
|
||||
GetLocationInformation(interp, codePtr->procPtr, &file, &line);
|
||||
|
||||
/*
|
||||
* Build the overall result.
|
||||
|
||||
+63
-78
@@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src);
|
||||
* convert between various character sets and UTF-8.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
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,
|
||||
@@ -57,7 +57,7 @@ typedef struct {
|
||||
* encoding.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct TableEncodingData {
|
||||
int fallback; /* Character (in this encoding) to substitute
|
||||
* when this encoding cannot represent a UTF-8
|
||||
* character. */
|
||||
@@ -91,7 +91,7 @@ typedef struct {
|
||||
* for switching character sets.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct EscapeSubTable {
|
||||
unsigned sequenceLen; /* Length of following string. */
|
||||
char sequence[16]; /* Escape code that marks this encoding. */
|
||||
char name[32]; /* Name for encoding. */
|
||||
@@ -100,7 +100,7 @@ typedef struct {
|
||||
* yet. */
|
||||
} EscapeSubTable;
|
||||
|
||||
typedef struct {
|
||||
typedef struct EscapeEncodingData {
|
||||
int fallback; /* Character (in this encoding) to substitute
|
||||
* when this encoding cannot represent a UTF-8
|
||||
* character. */
|
||||
@@ -563,7 +563,7 @@ TclInitEncodingSubsystem(void)
|
||||
* formed UTF-8 into a properly formed stream.
|
||||
*/
|
||||
|
||||
type.encodingName = NULL;
|
||||
type.encodingName = "identity";
|
||||
type.toUtfProc = BinaryProc;
|
||||
type.fromUtfProc = BinaryProc;
|
||||
type.freeProc = NULL;
|
||||
@@ -693,7 +693,6 @@ TclFinalizeEncodingSubsystem(void)
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
const char *
|
||||
Tcl_GetDefaultEncodingDir(void)
|
||||
{
|
||||
@@ -737,7 +736,6 @@ Tcl_SetDefaultEncodingDir(
|
||||
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
|
||||
Tcl_SetEncodingSearchPath(searchPath);
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*-------------------------------------------------------------------------
|
||||
@@ -853,9 +851,7 @@ FreeEncoding(
|
||||
if (encodingPtr->hPtr != NULL) {
|
||||
Tcl_DeleteHashEntry(encodingPtr->hPtr);
|
||||
}
|
||||
if (encodingPtr->name) {
|
||||
ckfree(encodingPtr->name);
|
||||
}
|
||||
ckfree(encodingPtr->name);
|
||||
ckfree(encodingPtr);
|
||||
}
|
||||
}
|
||||
@@ -1044,8 +1040,27 @@ Tcl_CreateEncoding(
|
||||
const Tcl_EncodingType *typePtr)
|
||||
/* The encoding type. */
|
||||
{
|
||||
Encoding *encodingPtr = ckalloc(sizeof(Encoding));
|
||||
encodingPtr->name = NULL;
|
||||
Tcl_HashEntry *hPtr;
|
||||
int isNew;
|
||||
Encoding *encodingPtr;
|
||||
char *name;
|
||||
|
||||
Tcl_MutexLock(&encodingMutex);
|
||||
hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
|
||||
if (isNew == 0) {
|
||||
/*
|
||||
* Remove old encoding from hash table, but don't delete it until last
|
||||
* reference goes away.
|
||||
*/
|
||||
|
||||
encodingPtr = Tcl_GetHashValue(hPtr);
|
||||
encodingPtr->hPtr = NULL;
|
||||
}
|
||||
|
||||
name = ckalloc(strlen(typePtr->encodingName) + 1);
|
||||
|
||||
encodingPtr = ckalloc(sizeof(Encoding));
|
||||
encodingPtr->name = strcpy(name, typePtr->encodingName);
|
||||
encodingPtr->toUtfProc = typePtr->toUtfProc;
|
||||
encodingPtr->fromUtfProc = typePtr->fromUtfProc;
|
||||
encodingPtr->freeProc = typePtr->freeProc;
|
||||
@@ -1057,32 +1072,11 @@ Tcl_CreateEncoding(
|
||||
encodingPtr->lengthProc = (LengthProc *) unilen;
|
||||
}
|
||||
encodingPtr->refCount = 1;
|
||||
encodingPtr->hPtr = NULL;
|
||||
|
||||
if (typePtr->encodingName) {
|
||||
Tcl_HashEntry *hPtr;
|
||||
int isNew;
|
||||
char *name;
|
||||
|
||||
Tcl_MutexLock(&encodingMutex);
|
||||
hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
|
||||
if (isNew == 0) {
|
||||
/*
|
||||
* Remove old encoding from hash table, but don't delete it until last
|
||||
* reference goes away.
|
||||
*/
|
||||
|
||||
Encoding *replaceMe = Tcl_GetHashValue(hPtr);
|
||||
replaceMe->hPtr = NULL;
|
||||
}
|
||||
|
||||
name = ckalloc(strlen(typePtr->encodingName) + 1);
|
||||
encodingPtr->name = strcpy(name, typePtr->encodingName);
|
||||
encodingPtr->hPtr = hPtr;
|
||||
Tcl_SetHashValue(hPtr, encodingPtr);
|
||||
|
||||
Tcl_MutexUnlock(&encodingMutex);
|
||||
}
|
||||
|
||||
return (Tcl_Encoding) encodingPtr;
|
||||
}
|
||||
|
||||
@@ -2299,11 +2293,8 @@ UtfToUtfProc(
|
||||
const char *srcStart, *srcEnd, *srcClose;
|
||||
const char *dstStart, *dstEnd;
|
||||
int result, numChars, charLimit = INT_MAX;
|
||||
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
|
||||
Tcl_UniChar ch;
|
||||
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
*statePtr = 0;
|
||||
}
|
||||
result = TCL_OK;
|
||||
|
||||
srcStart = src;
|
||||
@@ -2335,7 +2326,7 @@ UtfToUtfProc(
|
||||
}
|
||||
if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
|
||||
/*
|
||||
* Copy 7bit characters, but skip null-bytes when we are in input
|
||||
* Copy 7bit chatacters, but skip null-bytes when we are in input
|
||||
* mode, so that they get converted to 0xc080.
|
||||
*/
|
||||
|
||||
@@ -2350,17 +2341,17 @@ UtfToUtfProc(
|
||||
src += 2;
|
||||
} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
|
||||
/*
|
||||
* Always check before using TclUtfToUniChar. Not doing can so
|
||||
* cause it run beyond the end of the buffer! If we happen such an
|
||||
* incomplete char its bytes are made to represent themselves.
|
||||
* Always check before using Tcl_UtfToUniChar. Not doing can so
|
||||
* cause it run beyond the endof the buffer! If we happen such an
|
||||
* incomplete char its byts are made to represent themselves.
|
||||
*/
|
||||
|
||||
*chPtr = (unsigned char) *src;
|
||||
ch = (unsigned char) *src;
|
||||
src += 1;
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
} else {
|
||||
src += TclUtfToUniChar(src, chPtr);
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
src += Tcl_UtfToUniChar(src, &ch);
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2416,11 +2407,8 @@ UnicodeToUtfProc(
|
||||
const char *srcStart, *srcEnd;
|
||||
const char *dstEnd, *dstStart;
|
||||
int result, numChars, charLimit = INT_MAX;
|
||||
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
|
||||
Tcl_UniChar ch;
|
||||
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
*statePtr = 0;
|
||||
}
|
||||
if (flags & TCL_ENCODING_CHAR_LIMIT) {
|
||||
charLimit = *dstCharsPtr;
|
||||
}
|
||||
@@ -2448,11 +2436,11 @@ UnicodeToUtfProc(
|
||||
* Tcl_UniChar-size data.
|
||||
*/
|
||||
|
||||
*chPtr = *(Tcl_UniChar *)src;
|
||||
if (*chPtr && *chPtr < 0x80) {
|
||||
*dst++ = (*chPtr & 0xFF);
|
||||
ch = *(Tcl_UniChar *)src;
|
||||
if (ch && ch < 0x80) {
|
||||
*dst++ = (ch & 0xFF);
|
||||
} else {
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
}
|
||||
src += sizeof(Tcl_UniChar);
|
||||
}
|
||||
@@ -2509,11 +2497,8 @@ UtfToUnicodeProc(
|
||||
{
|
||||
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
|
||||
int result, numChars;
|
||||
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
|
||||
Tcl_UniChar ch;
|
||||
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
*statePtr = 0;
|
||||
}
|
||||
srcStart = src;
|
||||
srcEnd = src + srcLen;
|
||||
srcClose = srcEnd;
|
||||
@@ -2539,7 +2524,7 @@ UtfToUnicodeProc(
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
break;
|
||||
}
|
||||
src += TclUtfToUniChar(src, chPtr);
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
|
||||
/*
|
||||
* Need to handle this in a way that won't cause misalignment by
|
||||
@@ -2548,23 +2533,23 @@ UtfToUnicodeProc(
|
||||
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
#if TCL_UTF_MAX > 4
|
||||
*dst++ = (*chPtr >> 24);
|
||||
*dst++ = ((*chPtr >> 16) & 0xFF);
|
||||
*dst++ = ((*chPtr >> 8) & 0xFF);
|
||||
*dst++ = (*chPtr & 0xFF);
|
||||
*dst++ = (ch >> 24);
|
||||
*dst++ = ((ch >> 16) & 0xFF);
|
||||
*dst++ = ((ch >> 8) & 0xFF);
|
||||
*dst++ = (ch & 0xFF);
|
||||
#else
|
||||
*dst++ = (*chPtr >> 8);
|
||||
*dst++ = (*chPtr & 0xFF);
|
||||
*dst++ = (ch >> 8);
|
||||
*dst++ = (ch & 0xFF);
|
||||
#endif
|
||||
#else
|
||||
#if TCL_UTF_MAX > 4
|
||||
*dst++ = (*chPtr & 0xFF);
|
||||
*dst++ = ((*chPtr >> 8) & 0xFF);
|
||||
*dst++ = ((*chPtr >> 16) & 0xFF);
|
||||
*dst++ = (*chPtr >> 24);
|
||||
*dst++ = (ch & 0xFF);
|
||||
*dst++ = ((ch >> 8) & 0xFF);
|
||||
*dst++ = ((ch >> 16) & 0xFF);
|
||||
*dst++ = (ch >> 24);
|
||||
#else
|
||||
*dst++ = (*chPtr & 0xFF);
|
||||
*dst++ = (*chPtr >> 8);
|
||||
*dst++ = (ch & 0xFF);
|
||||
*dst++ = (ch >> 8);
|
||||
#endif
|
||||
#endif
|
||||
}
|
||||
@@ -2622,7 +2607,7 @@ TableToUtfProc(
|
||||
const char *srcStart, *srcEnd;
|
||||
const char *dstEnd, *dstStart, *prefixBytes;
|
||||
int result, byte, numChars, charLimit = INT_MAX;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
const unsigned short *const *toUnicode;
|
||||
const unsigned short *pageZero;
|
||||
TableEncodingData *dataPtr = clientData;
|
||||
@@ -2734,7 +2719,7 @@ TableFromUtfProc(
|
||||
{
|
||||
const char *srcStart, *srcEnd, *srcClose;
|
||||
const char *dstStart, *dstEnd, *prefixBytes;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
int result, len, word, numChars;
|
||||
TableEncodingData *dataPtr = clientData;
|
||||
const unsigned short *const *fromUnicode;
|
||||
@@ -2868,7 +2853,7 @@ Iso88591ToUtfProc(
|
||||
|
||||
result = TCL_OK;
|
||||
for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
|
||||
if (dst > dstEnd) {
|
||||
result = TCL_CONVERT_NOSPACE;
|
||||
@@ -2954,7 +2939,7 @@ Iso88591FromUtfProc(
|
||||
dstEnd = dst + dstLen - 1;
|
||||
|
||||
for (numChars = 0; src < srcEnd; numChars++) {
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
int len;
|
||||
|
||||
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
|
||||
@@ -3341,7 +3326,7 @@ EscapeFromUtfProc(
|
||||
for (numChars = 0; src < srcEnd; numChars++) {
|
||||
unsigned len;
|
||||
int word;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
|
||||
if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
|
||||
/*
|
||||
@@ -3386,7 +3371,7 @@ EscapeFromUtfProc(
|
||||
|
||||
/*
|
||||
* The state variable has the value of oldState when word is 0.
|
||||
* In this case, the escape sequence should not be copied to dst
|
||||
* In this case, the escape sequense should not be copied to dst
|
||||
* because the current character set is not changed.
|
||||
*/
|
||||
|
||||
@@ -3611,7 +3596,7 @@ unilen(
|
||||
static void
|
||||
InitializeEncodingSearchPath(
|
||||
char **valuePtr,
|
||||
unsigned int *lengthPtr,
|
||||
size_t *lengthPtr,
|
||||
Tcl_Encoding *encodingPtr)
|
||||
{
|
||||
const char *bytes;
|
||||
|
||||
+150
-188
@@ -92,7 +92,7 @@ static const Tcl_ObjType ensembleCmdType = {
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
unsigned int epoch; /* Used to confirm when the data in this
|
||||
int epoch; /* Used to confirm when the data in this
|
||||
* really structure matches up with the
|
||||
* ensemble. */
|
||||
Command *token; /* Reference to the command for which this
|
||||
@@ -146,12 +146,10 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Tcl_Namespace *namespacePtr;
|
||||
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
|
||||
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
|
||||
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
|
||||
Tcl_Command token;
|
||||
Tcl_DictSearch search;
|
||||
Tcl_Obj *listObj;
|
||||
const char *simpleName;
|
||||
int index, done;
|
||||
|
||||
if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
|
||||
@@ -197,8 +195,13 @@ TclNamespaceEnsembleCmd(
|
||||
objv += 2;
|
||||
objc -= 2;
|
||||
|
||||
name = nsPtr->name;
|
||||
cxtPtr = (Namespace *) nsPtr->parentPtr;
|
||||
/*
|
||||
* Work out what name to use for the command to create. If supplied,
|
||||
* it is either fully specified or relative to the current namespace.
|
||||
* If not supplied, it is exactly the name of the current namespace.
|
||||
*/
|
||||
|
||||
name = nsPtr->fullName;
|
||||
|
||||
/*
|
||||
* Parse the option list, applying type checks as we go. Note that we
|
||||
@@ -218,7 +221,6 @@ TclNamespaceEnsembleCmd(
|
||||
switch ((enum EnsCreateOpts) index) {
|
||||
case CRT_CMD:
|
||||
name = TclGetString(objv[1]);
|
||||
cxtPtr = nsPtr;
|
||||
continue;
|
||||
case CRT_SUBCMDS:
|
||||
if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
|
||||
@@ -335,10 +337,6 @@ TclNamespaceEnsembleCmd(
|
||||
}
|
||||
}
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, cxtPtr,
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
|
||||
&simpleName);
|
||||
|
||||
/*
|
||||
* Create the ensemble. Note that this might delete another ensemble
|
||||
* linked to the same namespace, so we must be careful. However, we
|
||||
@@ -346,9 +344,8 @@ TclNamespaceEnsembleCmd(
|
||||
* we've created it (and after any deletions have occurred.)
|
||||
*/
|
||||
|
||||
token = TclCreateEnsembleInNs(interp, simpleName,
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
|
||||
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
|
||||
token = Tcl_CreateEnsemble(interp, name, NULL,
|
||||
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
|
||||
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
|
||||
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
|
||||
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
|
||||
@@ -639,38 +636,48 @@ TclNamespaceEnsembleCmd(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCreateEnsembleInNs --
|
||||
* Tcl_CreateEnsemble --
|
||||
*
|
||||
* Like Tcl_CreateEnsemble, but additionally accepts as an argument the
|
||||
* name of the namespace to create the command in.
|
||||
* Create a simple ensemble attached to the given namespace.
|
||||
*
|
||||
* Results:
|
||||
* The token for the command created.
|
||||
*
|
||||
* Side effects:
|
||||
* The ensemble is created and marked for compilation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Command
|
||||
TclCreateEnsembleInNs(
|
||||
Tcl_CreateEnsemble(
|
||||
Tcl_Interp *interp,
|
||||
|
||||
const char *name, /* Simple name of command to create (no */
|
||||
/* namespace components). */
|
||||
Tcl_Namespace /* Name of namespace to create the command in. */
|
||||
*nameNsPtr,
|
||||
Tcl_Namespace
|
||||
*ensembleNsPtr, /* Name of the namespace for the ensemble. */
|
||||
int flags
|
||||
)
|
||||
const char *name,
|
||||
Tcl_Namespace *namespacePtr,
|
||||
int flags)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
Tcl_Command token;
|
||||
Namespace *nsPtr = (Namespace *) namespacePtr;
|
||||
EnsembleConfig *ensemblePtr = ckalloc(sizeof(EnsembleConfig));
|
||||
Tcl_Obj *nameObj = NULL;
|
||||
|
||||
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
|
||||
token = TclNRCreateCommandInNs(interp, name,
|
||||
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
|
||||
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
|
||||
if (token == NULL) {
|
||||
ckfree(ensemblePtr);
|
||||
return NULL;
|
||||
if (nsPtr == NULL) {
|
||||
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
|
||||
}
|
||||
|
||||
/*
|
||||
* Make the name of the ensemble into a fully qualified name. This might
|
||||
* allocate a temporary object.
|
||||
*/
|
||||
|
||||
if (!(name[0] == ':' && name[1] == ':')) {
|
||||
nameObj = NewNsObj((Tcl_Namespace *) nsPtr);
|
||||
if (nsPtr->parentPtr == NULL) {
|
||||
Tcl_AppendStringsToObj(nameObj, name, NULL);
|
||||
} else {
|
||||
Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
|
||||
}
|
||||
Tcl_IncrRefCount(nameObj);
|
||||
name = TclGetString(nameObj);
|
||||
}
|
||||
|
||||
ensemblePtr->nsPtr = nsPtr;
|
||||
@@ -683,7 +690,9 @@ TclCreateEnsembleInNs(
|
||||
ensemblePtr->numParameters = 0;
|
||||
ensemblePtr->parameterList = NULL;
|
||||
ensemblePtr->unknownHandler = NULL;
|
||||
ensemblePtr->token = token;
|
||||
ensemblePtr->token = Tcl_NRCreateCommand(interp, name,
|
||||
NsEnsembleImplementationCmd, NsEnsembleImplementationCmdNR,
|
||||
ensemblePtr, DeleteEnsembleConfig);
|
||||
ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
|
||||
nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;
|
||||
|
||||
@@ -700,52 +709,11 @@ TclCreateEnsembleInNs(
|
||||
((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
|
||||
}
|
||||
|
||||
return ensemblePtr->token;
|
||||
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CreateEnsemble
|
||||
*
|
||||
* Create a simple ensemble attached to the given namespace.
|
||||
*
|
||||
* Deprecated by TclCreateEnsembleInNs.
|
||||
*
|
||||
* Value
|
||||
*
|
||||
* The token for the command created.
|
||||
*
|
||||
* Effect
|
||||
* The ensemble is created and marked for compilation.
|
||||
*
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Command
|
||||
Tcl_CreateEnsemble(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *namespacePtr,
|
||||
int flags)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
|
||||
*actualNsPtr;
|
||||
const char * simpleName;
|
||||
|
||||
if (nsPtr == NULL) {
|
||||
nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
|
||||
if (nameObj != NULL) {
|
||||
TclDecrRefCount(nameObj);
|
||||
}
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
|
||||
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
|
||||
return TclCreateEnsembleInNs(interp, simpleName,
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
|
||||
return ensemblePtr->token;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -1917,7 +1885,6 @@ NsEnsembleImplementationCmdNR(
|
||||
|
||||
TclSkipTailcall(interp);
|
||||
Tcl_ListObjGetElements(NULL, copyPtr, ©Objc, ©Objv);
|
||||
((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
|
||||
return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
|
||||
}
|
||||
|
||||
@@ -2431,32 +2398,14 @@ MakeCachedEnsembleCommand(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
ClearTable(
|
||||
EnsembleConfig *ensemblePtr)
|
||||
{
|
||||
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
|
||||
|
||||
if (hash->numEntries != 0) {
|
||||
Tcl_HashSearch search;
|
||||
Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);
|
||||
|
||||
while (hPtr != NULL) {
|
||||
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
|
||||
Tcl_DecrRefCount(prefixObj);
|
||||
hPtr = Tcl_NextHashEntry(&search);
|
||||
}
|
||||
ckfree((char *) ensemblePtr->subcommandArrayPtr);
|
||||
}
|
||||
Tcl_DeleteHashTable(hash);
|
||||
}
|
||||
|
||||
static void
|
||||
DeleteEnsembleConfig(
|
||||
ClientData clientData)
|
||||
{
|
||||
EnsembleConfig *ensemblePtr = clientData;
|
||||
Namespace *nsPtr = ensemblePtr->nsPtr;
|
||||
Tcl_HashSearch search;
|
||||
Tcl_HashEntry *hEnt;
|
||||
|
||||
/*
|
||||
* Unlink from the ensemble chain if it has not been marked as having been
|
||||
@@ -2490,7 +2439,17 @@ DeleteEnsembleConfig(
|
||||
* Kill the pointer-containing fields.
|
||||
*/
|
||||
|
||||
ClearTable(ensemblePtr);
|
||||
if (ensemblePtr->subcommandTable.numEntries != 0) {
|
||||
ckfree(ensemblePtr->subcommandArrayPtr);
|
||||
}
|
||||
hEnt = Tcl_FirstHashEntry(&ensemblePtr->subcommandTable, &search);
|
||||
while (hEnt != NULL) {
|
||||
Tcl_Obj *prefixObj = Tcl_GetHashValue(hEnt);
|
||||
|
||||
Tcl_DecrRefCount(prefixObj);
|
||||
hEnt = Tcl_NextHashEntry(&search);
|
||||
}
|
||||
Tcl_DeleteHashTable(&ensemblePtr->subcommandTable);
|
||||
if (ensemblePtr->subcmdList != NULL) {
|
||||
Tcl_DecrRefCount(ensemblePtr->subcmdList);
|
||||
}
|
||||
@@ -2546,101 +2505,100 @@ BuildEnsembleConfig(
|
||||
int i, j, isNew;
|
||||
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
|
||||
Tcl_Obj *subList = ensemblePtr->subcmdList;
|
||||
|
||||
ClearTable(ensemblePtr);
|
||||
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
|
||||
if (hash->numEntries != 0) {
|
||||
/*
|
||||
* Remove pre-existing table.
|
||||
*/
|
||||
|
||||
if (subList) {
|
||||
int subc;
|
||||
Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
|
||||
char *name;
|
||||
ckfree(ensemblePtr->subcommandArrayPtr);
|
||||
hPtr = Tcl_FirstHashEntry(hash, &search);
|
||||
while (hPtr != NULL) {
|
||||
Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
|
||||
|
||||
/*
|
||||
* There is a list of exactly what subcommands go in the table.
|
||||
* Must determine the target for each.
|
||||
*/
|
||||
Tcl_DecrRefCount(prefixObj);
|
||||
hPtr = Tcl_NextHashEntry(&search);
|
||||
}
|
||||
Tcl_DeleteHashTable(hash);
|
||||
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
|
||||
}
|
||||
|
||||
Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
|
||||
if (subList == mapDict) {
|
||||
/*
|
||||
* Strange case where explicit list of subcommands is same value
|
||||
* as the dict mapping to targets.
|
||||
*/
|
||||
/*
|
||||
* See if we've got an export list. If so, we will only export exactly
|
||||
* those commands, which may be either implemented by the prefix in the
|
||||
* subcommandDict or mapped directly onto the namespace's commands.
|
||||
*/
|
||||
|
||||
for (i = 0; i < subc; i += 2) {
|
||||
name = TclGetString(subv[i]);
|
||||
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
|
||||
if (!isNew) {
|
||||
cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
|
||||
Tcl_DecrRefCount(cmdObj);
|
||||
}
|
||||
Tcl_SetHashValue(hPtr, subv[i+1]);
|
||||
Tcl_IncrRefCount(subv[i+1]);
|
||||
if (ensemblePtr->subcmdList != NULL) {
|
||||
Tcl_Obj **subcmdv, *target, *cmdObj, *cmdPrefixObj;
|
||||
int subcmdc;
|
||||
|
||||
name = TclGetString(subv[i+1]);
|
||||
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
|
||||
if (isNew) {
|
||||
cmdObj = Tcl_NewStringObj(name, -1);
|
||||
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
|
||||
Tcl_SetHashValue(hPtr, cmdPrefixObj);
|
||||
Tcl_IncrRefCount(cmdPrefixObj);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/* Usual case where we can freely act on the list and dict. */
|
||||
TclListObjGetElements(NULL, ensemblePtr->subcmdList, &subcmdc,
|
||||
&subcmdv);
|
||||
for (i=0 ; i<subcmdc ; i++) {
|
||||
const char *name = TclGetString(subcmdv[i]);
|
||||
|
||||
for (i = 0; i < subc; i++) {
|
||||
name = TclGetString(subv[i]);
|
||||
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
|
||||
if (!isNew) {
|
||||
continue;
|
||||
}
|
||||
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
|
||||
|
||||
/* Lookup target in the dictionary */
|
||||
if (mapDict) {
|
||||
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
|
||||
if (target) {
|
||||
Tcl_SetHashValue(hPtr, target);
|
||||
Tcl_IncrRefCount(target);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
/*
|
||||
* Skip non-unique cases.
|
||||
*/
|
||||
|
||||
/*
|
||||
* target was not in the dictionary so map onto the namespace.
|
||||
* Note in this case that we do not guarantee that the
|
||||
* command is actually there; that is the programmer's
|
||||
* responsibility (or [::unknown] of course).
|
||||
*/
|
||||
cmdObj = Tcl_NewStringObj(name, -1);
|
||||
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
|
||||
Tcl_SetHashValue(hPtr, cmdPrefixObj);
|
||||
Tcl_IncrRefCount(cmdPrefixObj);
|
||||
}
|
||||
}
|
||||
} else if (mapDict) {
|
||||
/*
|
||||
* No subcmd list, but we do have a mapping dictionary so we should
|
||||
* use the keys of that. Convert the dictionary's contents into the
|
||||
* form required for the ensemble's internal hashtable.
|
||||
*/
|
||||
if (!isNew) {
|
||||
continue;
|
||||
}
|
||||
|
||||
Tcl_DictSearch dictSearch;
|
||||
Tcl_Obj *keyObj, *valueObj;
|
||||
int done;
|
||||
/*
|
||||
* Look in our dictionary (if present) for the command.
|
||||
*/
|
||||
|
||||
Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
|
||||
&keyObj, &valueObj, &done);
|
||||
while (!done) {
|
||||
char *name = TclGetString(keyObj);
|
||||
if (ensemblePtr->subcommandDict != NULL) {
|
||||
Tcl_DictObjGet(NULL, ensemblePtr->subcommandDict, subcmdv[i],
|
||||
&target);
|
||||
if (target != NULL) {
|
||||
Tcl_SetHashValue(hPtr, target);
|
||||
Tcl_IncrRefCount(target);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
|
||||
Tcl_SetHashValue(hPtr, valueObj);
|
||||
Tcl_IncrRefCount(valueObj);
|
||||
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
|
||||
}
|
||||
/*
|
||||
* Not there, so map onto the namespace. Note in this case that we
|
||||
* do not guarantee that the command is actually there; that is
|
||||
* the programmer's responsibility (or [::unknown] of course).
|
||||
*/
|
||||
|
||||
cmdObj = NewNsObj((Tcl_Namespace *) ensemblePtr->nsPtr);
|
||||
if (ensemblePtr->nsPtr->parentPtr != NULL) {
|
||||
Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
|
||||
} else {
|
||||
Tcl_AppendStringsToObj(cmdObj, name, NULL);
|
||||
}
|
||||
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
|
||||
Tcl_SetHashValue(hPtr, cmdPrefixObj);
|
||||
Tcl_IncrRefCount(cmdPrefixObj);
|
||||
}
|
||||
} else if (ensemblePtr->subcommandDict != NULL) {
|
||||
/*
|
||||
* No subcmd list, but we do have a mapping dictionary so we should
|
||||
* use the keys of that. Convert the dictionary's contents into the
|
||||
* form required for the ensemble's internal hashtable.
|
||||
*/
|
||||
|
||||
Tcl_DictSearch dictSearch;
|
||||
Tcl_Obj *keyObj, *valueObj;
|
||||
int done;
|
||||
|
||||
Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
|
||||
&keyObj, &valueObj, &done);
|
||||
while (!done) {
|
||||
const char *name = TclGetString(keyObj);
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
|
||||
Tcl_SetHashValue(hPtr, valueObj);
|
||||
Tcl_IncrRefCount(valueObj);
|
||||
Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Discover what commands are actually exported by the namespace.
|
||||
@@ -2676,7 +2634,11 @@ BuildEnsembleConfig(
|
||||
if (isNew) {
|
||||
Tcl_Obj *cmdObj, *cmdPrefixObj;
|
||||
|
||||
cmdObj = Tcl_NewStringObj(nsCmdName, -1);
|
||||
TclNewObj(cmdObj);
|
||||
Tcl_AppendStringsToObj(cmdObj,
|
||||
ensemblePtr->nsPtr->fullName,
|
||||
(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
|
||||
nsCmdName, NULL);
|
||||
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
|
||||
Tcl_SetHashValue(hPtr, cmdPrefixObj);
|
||||
Tcl_IncrRefCount(cmdPrefixObj);
|
||||
|
||||
@@ -130,7 +130,6 @@ TclSetupEnv(
|
||||
* '='; ignore the entry.
|
||||
*/
|
||||
|
||||
Tcl_DStringFree(&envString);
|
||||
continue;
|
||||
}
|
||||
p2++;
|
||||
|
||||
+2
-1
@@ -37,7 +37,7 @@ typedef struct BgError {
|
||||
* pending background errors for the interpreter.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ErrAssocData {
|
||||
Tcl_Interp *interp; /* Interpreter in which error occurred. */
|
||||
Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */
|
||||
BgError *firstBgPtr; /* First in list of all background errors
|
||||
@@ -1057,6 +1057,7 @@ TclInitSubsystems(void)
|
||||
* mutexes. */
|
||||
TclInitIOSubsystem(); /* Inits a tsd key (noop). */
|
||||
TclInitEncodingSubsystem(); /* Process wide encoding init. */
|
||||
TclpSetInterfaces();
|
||||
TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
|
||||
subsystemsInitialized = 1;
|
||||
}
|
||||
|
||||
+742
-361
File diff suppressed because it is too large
Load Diff
@@ -1904,7 +1904,7 @@ TclGlob(
|
||||
}
|
||||
|
||||
/*
|
||||
* To process a [glob] invocation, this function may be called multiple
|
||||
* To process a [glob] invokation, this function may be called multiple
|
||||
* times. Each time, the previously discovered filenames are in the
|
||||
* interpreter result. We stash that away here so the result is free for
|
||||
* error messsages.
|
||||
|
||||
+1
-1
@@ -142,7 +142,7 @@ Tcl_GetBoolean(
|
||||
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
|
||||
}
|
||||
if (code == TCL_OK) {
|
||||
TclGetBooleanFromObj(NULL, &obj, boolPtr);
|
||||
*boolPtr = obj.internalRep.longValue;
|
||||
}
|
||||
return code;
|
||||
}
|
||||
|
||||
+18
-8
@@ -45,6 +45,19 @@ static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
|
||||
static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
|
||||
static TCL_HASH_TYPE HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
|
||||
|
||||
/*
|
||||
* Prototypes for the one word hash key methods. Not actually declared because
|
||||
* this is a critical path that is implemented in the core hash table access
|
||||
* function.
|
||||
*/
|
||||
|
||||
#if 0
|
||||
static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr,
|
||||
void *keyPtr);
|
||||
static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
|
||||
static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Prototypes for the string hash key methods.
|
||||
*/
|
||||
@@ -985,18 +998,12 @@ static void
|
||||
RebuildTable(
|
||||
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
|
||||
{
|
||||
int count, index, oldSize = tablePtr->numBuckets;
|
||||
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
|
||||
int oldSize, count, index;
|
||||
Tcl_HashEntry **oldBuckets;
|
||||
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
|
||||
register Tcl_HashEntry *hPtr;
|
||||
const Tcl_HashKeyType *typePtr;
|
||||
|
||||
/* Avoid outgrowing capability of the memory allocators */
|
||||
if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
|
||||
tablePtr->rebuildSize = INT_MAX;
|
||||
return;
|
||||
}
|
||||
|
||||
if (tablePtr->keyType == TCL_STRING_KEYS) {
|
||||
typePtr = &tclStringHashKeyType;
|
||||
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
|
||||
@@ -1008,6 +1015,9 @@ RebuildTable(
|
||||
typePtr = &tclArrayHashKeyType;
|
||||
}
|
||||
|
||||
oldSize = tablePtr->numBuckets;
|
||||
oldBuckets = tablePtr->buckets;
|
||||
|
||||
/*
|
||||
* Allocate and initialize the new bucket array, and set up hashing
|
||||
* constants for new array size.
|
||||
|
||||
@@ -62,14 +62,15 @@ Tcl_RecordAndEval(
|
||||
* instead of Tcl_Eval. */
|
||||
{
|
||||
register Tcl_Obj *cmdPtr;
|
||||
int length = strlen(cmd);
|
||||
int result;
|
||||
|
||||
if (cmd[0]) {
|
||||
if (length > 0) {
|
||||
/*
|
||||
* Call Tcl_RecordAndEvalObj to do the actual work.
|
||||
*/
|
||||
|
||||
cmdPtr = Tcl_NewStringObj(cmd, -1);
|
||||
cmdPtr = Tcl_NewStringObj(cmd, length);
|
||||
Tcl_IncrRefCount(cmdPtr);
|
||||
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
|
||||
|
||||
|
||||
+342
-417
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -214,7 +214,7 @@ typedef struct ChannelState {
|
||||
* because it happened in the background. The
|
||||
* value is the chanMg, if any. #219's
|
||||
* companion to 'unreportedError'. */
|
||||
size_t epoch; /* Used to test validity of stored channelname
|
||||
int epoch; /* Used to test validity of stored channelname
|
||||
* lookup results. */
|
||||
} ChannelState;
|
||||
|
||||
|
||||
+19
-32
@@ -25,7 +25,7 @@ typedef struct AcceptCallback {
|
||||
* It must be per-thread because of std channel limitations.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ThreadSpecificData {
|
||||
int initialized; /* Set to 1 when the module is initialized. */
|
||||
Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
|
||||
} ThreadSpecificData;
|
||||
@@ -113,6 +113,7 @@ Tcl_PutsObjCmd(
|
||||
int newline; /* Add a newline at end? */
|
||||
int result; /* Result of puts operation. */
|
||||
int mode; /* Mode in which channel is opened. */
|
||||
ThreadSpecificData *tsdPtr;
|
||||
|
||||
switch (objc) {
|
||||
case 2: /* [puts $x] */
|
||||
@@ -137,7 +138,7 @@ Tcl_PutsObjCmd(
|
||||
chanObjPtr = objv[2];
|
||||
string = objv[3];
|
||||
break;
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
|
||||
/*
|
||||
* The code below provides backwards compatibility with an old
|
||||
@@ -159,7 +160,7 @@ Tcl_PutsObjCmd(
|
||||
}
|
||||
|
||||
if (chanObjPtr == NULL) {
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (!tsdPtr->initialized) {
|
||||
tsdPtr->initialized = 1;
|
||||
@@ -439,7 +440,7 @@ Tcl_ReadObjCmd(
|
||||
if (i < objc) {
|
||||
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|
||||
|| (toRead < 0)) {
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
/*
|
||||
* The code below provides backwards compatibility with an old
|
||||
* form of the command that is no longer recommended or
|
||||
@@ -454,7 +455,7 @@ Tcl_ReadObjCmd(
|
||||
TclGetString(objv[i])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
|
||||
return TCL_ERROR;
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
}
|
||||
newline = 1;
|
||||
#endif
|
||||
@@ -1617,34 +1618,19 @@ Tcl_SocketObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Set the options to their default value if the user didn't override
|
||||
* their value.
|
||||
*/
|
||||
// Set the options to their default value if the user didn't override their
|
||||
// value.
|
||||
if (reusep == -1) reusep = 0;
|
||||
if (reusea == -1) reusea = 1;
|
||||
|
||||
if (reusep == -1) {
|
||||
reusep = 0;
|
||||
}
|
||||
if (reusea == -1) {
|
||||
reusea = 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Build the bitset with the flags values.
|
||||
*/
|
||||
|
||||
if (reusea) {
|
||||
// Build the bitset with the flags values.
|
||||
if (reusea)
|
||||
flags |= TCL_TCPSERVER_REUSEADDR;
|
||||
}
|
||||
if (reusep) {
|
||||
if (reusep)
|
||||
flags |= TCL_TCPSERVER_REUSEPORT;
|
||||
}
|
||||
|
||||
/*
|
||||
* All the arguments should have been parsed by now, 'a' points to the
|
||||
* last one, the port number.
|
||||
*/
|
||||
|
||||
// All the arguments should have been parsed by now, 'a' points to the last
|
||||
// one, the port number.
|
||||
if (a != objc-1) {
|
||||
goto wrongNumArgs;
|
||||
}
|
||||
@@ -1652,14 +1638,15 @@ Tcl_SocketObjCmd(
|
||||
port = TclGetString(objv[a]);
|
||||
|
||||
if (server) {
|
||||
AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback));
|
||||
AcceptCallback *acceptCallbackPtr =
|
||||
ckalloc(sizeof(AcceptCallback));
|
||||
|
||||
Tcl_IncrRefCount(script);
|
||||
acceptCallbackPtr->script = script;
|
||||
acceptCallbackPtr->interp = interp;
|
||||
|
||||
chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
|
||||
AcceptCallbackProc, acceptCallbackPtr);
|
||||
chan = Tcl_OpenTcpServerEx(interp, port, host, flags, AcceptCallbackProc,
|
||||
acceptCallbackPtr);
|
||||
if (chan == NULL) {
|
||||
Tcl_DecrRefCount(script);
|
||||
ckfree(acceptCallbackPtr);
|
||||
|
||||
+25
-46
@@ -41,8 +41,6 @@ static void ReflectWatch(ClientData clientData, int mask);
|
||||
static int ReflectBlock(ClientData clientData, int mode);
|
||||
#ifdef TCL_THREADS
|
||||
static void ReflectThread(ClientData clientData, int action);
|
||||
static int ReflectEventRun(Tcl_Event *ev, int flags);
|
||||
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
|
||||
#endif
|
||||
static Tcl_WideInt ReflectSeekWide(ClientData clientData,
|
||||
Tcl_WideInt offset, int mode, int *errorCodePtr);
|
||||
@@ -236,7 +234,7 @@ typedef enum {
|
||||
* sharing problems.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ForwardParamBase {
|
||||
int code; /* O: Ok/Fail of the cmd handler */
|
||||
char *msgStr; /* O: Error message for handler failure */
|
||||
int mustFree; /* O: True if msgStr is allocated, false if
|
||||
@@ -311,7 +309,7 @@ typedef struct ForwardingResult ForwardingResult;
|
||||
* General event structure, with reference to operation specific data.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ForwardingEvent {
|
||||
Tcl_Event event; /* Basic event data, has to be first item */
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardedOperation op; /* Forwarded driver operation */
|
||||
@@ -348,7 +346,7 @@ struct ForwardingResult {
|
||||
* results. */
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
typedef struct ThreadSpecificData {
|
||||
/*
|
||||
* Table of all reflected channels owned by this thread. This is the
|
||||
* per-thread version of the per-interpreter map.
|
||||
@@ -725,7 +723,7 @@ TclChanCreateObjCmd(
|
||||
Tcl_DecrRefCount(rcPtr->name);
|
||||
Tcl_DecrRefCount(rcPtr->methods);
|
||||
Tcl_DecrRefCount(rcPtr->cmd);
|
||||
ckfree(rcPtr);
|
||||
ckfree((char*) rcPtr);
|
||||
return TCL_ERROR;
|
||||
|
||||
#undef MODE
|
||||
@@ -750,8 +748,7 @@ TclChanCreateObjCmd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
typedef struct {
|
||||
typedef struct ReflectEvent {
|
||||
Tcl_Event header;
|
||||
ReflectedChannel *rcPtr;
|
||||
int events;
|
||||
@@ -794,7 +791,6 @@ ReflectEventDelete(
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
TclChanPostEventObjCmd(
|
||||
@@ -855,12 +851,11 @@ TclChanPostEventObjCmd(
|
||||
}
|
||||
|
||||
/*
|
||||
* Note that the search above subsumes several of the older checks,
|
||||
* namely:
|
||||
* Note that the search above subsumes several of the older checks, namely:
|
||||
*
|
||||
* (1) Does the channel handle refer to a reflected channel?
|
||||
* (1) Does the channel handle refer to a reflected channel ?
|
||||
* (2) Is the post event issued from the interpreter holding the handler
|
||||
* of the reflected channel?
|
||||
* of the reflected channel ?
|
||||
*
|
||||
* A successful search answers yes to both. Because the map holds only
|
||||
* handles of reflected channels, and only of such whose handler is
|
||||
@@ -944,8 +939,7 @@ TclChanPostEventObjCmd(
|
||||
|
||||
(void) GetThreadReflectedChannelMap();
|
||||
|
||||
/*
|
||||
* XXX Race condition !!
|
||||
/* XXX Race condition !!
|
||||
* XXX The destination thread may not exist anymore already.
|
||||
* XXX (Delayed postevent executed after channel got removed).
|
||||
* XXX Can we detect this ? (check the validity of the owner threadid ?)
|
||||
@@ -1227,8 +1221,8 @@ ReflectClose(
|
||||
#endif
|
||||
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
|
||||
if (tctPtr && tctPtr != &tclRChannelType) {
|
||||
ckfree(tctPtr);
|
||||
((Channel *)rcPtr->chan)->typePtr = NULL;
|
||||
ckfree(tctPtr);
|
||||
((Channel *)rcPtr->chan)->typePtr = NULL;
|
||||
}
|
||||
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
|
||||
return (result == TCL_OK) ? EOK : EINVAL;
|
||||
@@ -1278,10 +1272,7 @@ ReflectInput(
|
||||
|
||||
if (p.base.code != TCL_OK) {
|
||||
if (p.base.code < 0) {
|
||||
/*
|
||||
* No error message, this is an errno signal.
|
||||
*/
|
||||
|
||||
/* No error message, this is an errno signal. */
|
||||
*errorCodePtr = -p.base.code;
|
||||
} else {
|
||||
PassReceivedError(rcPtr->chan, &p);
|
||||
@@ -1384,10 +1375,7 @@ ReflectOutput(
|
||||
|
||||
if (p.base.code != TCL_OK) {
|
||||
if (p.base.code < 0) {
|
||||
/*
|
||||
* No error message, this is an errno signal.
|
||||
*/
|
||||
|
||||
/* No error message, this is an errno signal. */
|
||||
*errorCodePtr = -p.base.code;
|
||||
} else {
|
||||
PassReceivedError(rcPtr->chan, &p);
|
||||
@@ -1438,8 +1426,8 @@ ReflectOutput(
|
||||
|
||||
if ((written == 0) && (toWrite > 0)) {
|
||||
/*
|
||||
* The handler claims to have written nothing of what it was given.
|
||||
* That is bad.
|
||||
* The handler claims to have written nothing of what it was
|
||||
* given. That is bad.
|
||||
*/
|
||||
|
||||
SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
|
||||
@@ -2385,8 +2373,8 @@ InvokeTclMethod(
|
||||
* None.
|
||||
*
|
||||
* Users:
|
||||
* ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized
|
||||
* short reads/writes.
|
||||
* ReflectInput/Output(), to enable the signaling of EAGAIN
|
||||
* on 0-sized short reads/writes.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -2572,10 +2560,7 @@ DeleteReflectedChannelMap(
|
||||
|
||||
evPtr = resultPtr->evPtr;
|
||||
|
||||
/*
|
||||
* Basic crash safety until this routine can get revised [3411310]
|
||||
*/
|
||||
|
||||
/* Basic crash safety until this routine can get revised [3411310] */
|
||||
if (evPtr == NULL) {
|
||||
continue;
|
||||
}
|
||||
@@ -2690,8 +2675,8 @@ DeleteThreadReflectedChannelMap(
|
||||
|
||||
/*
|
||||
* Go through the list of pending results and cancel all whose events were
|
||||
* destined for this thread. While this is in progress we block any other
|
||||
* access to the list of pending results.
|
||||
* destined for this thread. While this is in progress we block any
|
||||
* other access to the list of pending results.
|
||||
*/
|
||||
|
||||
Tcl_MutexLock(&rcForwardMutex);
|
||||
@@ -2722,10 +2707,7 @@ DeleteThreadReflectedChannelMap(
|
||||
|
||||
evPtr = resultPtr->evPtr;
|
||||
|
||||
/*
|
||||
* Basic crash safety until this routine can get revised [3411310]
|
||||
*/
|
||||
|
||||
/* Basic crash safety until this routine can get revised [3411310] */
|
||||
if (evPtr == NULL ) {
|
||||
continue;
|
||||
}
|
||||
@@ -2779,8 +2761,8 @@ ForwardOpToHandlerThread(
|
||||
const void *param) /* Arguments */
|
||||
{
|
||||
/*
|
||||
* Core of the communication from OWNER to HANDLER thread. The receiver is
|
||||
* ForwardProc() below.
|
||||
* Core of the communication from OWNER to HANDLER thread.
|
||||
* The receiver is ForwardProc() below.
|
||||
*/
|
||||
|
||||
Tcl_ThreadId dst = rcPtr->thread;
|
||||
@@ -2830,10 +2812,7 @@ ForwardOpToHandlerThread(
|
||||
*/
|
||||
|
||||
TclSpliceIn(resultPtr, forwardList);
|
||||
|
||||
/*
|
||||
* Do not unlock here. That is done by the ConditionWait.
|
||||
*/
|
||||
/* Do not unlock here. That is done by the ConditionWait */
|
||||
|
||||
/*
|
||||
* Ensure cleanup of the event if the origin thread exits while this event
|
||||
@@ -2909,7 +2888,7 @@ ForwardProc(
|
||||
* Notes regarding access to the referenced data.
|
||||
*
|
||||
* In principle the data belongs to the originating thread (see
|
||||
* evPtr->src), however this thread is currently blocked at (*), i.e.,
|
||||
* evPtr->src), however this thread is currently blocked at (*), i.e.
|
||||
* quiescent. Because of this we can treat the data as belonging to us,
|
||||
* without fear of race conditions. I.e. we can read and write as we like.
|
||||
*
|
||||
|
||||
@@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = {
|
||||
* layers upon reading from the channel, plus the functions to manage such.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct _ResultBuffer_ {
|
||||
unsigned char *buf; /* Reference to the buffer area. */
|
||||
int allocated; /* Allocated size of the buffer area. */
|
||||
int used; /* Number of bytes in the buffer,
|
||||
@@ -253,7 +253,7 @@ typedef enum {
|
||||
* sharing problems.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ForwardParamBase {
|
||||
int code; /* O: Ok/Fail of the cmd handler */
|
||||
char *msgStr; /* O: Error message for handler failure */
|
||||
int mustFree; /* O: True if msgStr is allocated, false if
|
||||
@@ -298,7 +298,7 @@ typedef struct ForwardingResult ForwardingResult;
|
||||
* General event structure, with reference to operation specific data.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ForwardingEvent {
|
||||
Tcl_Event event; /* Basic event data, has to be first item */
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardedOperation op; /* Forwarded driver operation */
|
||||
@@ -329,7 +329,7 @@ struct ForwardingResult {
|
||||
* results. */
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
typedef struct ThreadSpecificData {
|
||||
/*
|
||||
* Table of all reflected transformations owned by this thread.
|
||||
*/
|
||||
|
||||
+10
-19
@@ -12,21 +12,16 @@
|
||||
#include "tclInt.h"
|
||||
|
||||
#if defined(_WIN32) && defined(UNICODE)
|
||||
/*
|
||||
* On Windows, we need to do proper Unicode->UTF-8 conversion.
|
||||
*/
|
||||
/* On Windows, we need to do proper Unicode->UTF-8 conversion. */
|
||||
|
||||
typedef struct {
|
||||
typedef struct ThreadSpecificData {
|
||||
int initialized;
|
||||
Tcl_DString errorMsg; /* UTF-8 encoded error-message */
|
||||
} ThreadSpecificData;
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
|
||||
#undef gai_strerror
|
||||
static const char *
|
||||
gai_strerror(
|
||||
int code)
|
||||
{
|
||||
static const char *gai_strerror(int code) {
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (tsdPtr->initialized) {
|
||||
@@ -131,7 +126,7 @@ TclSockMinimumBuffers(
|
||||
}
|
||||
len = sizeof(int);
|
||||
getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
|
||||
(char *) ¤t, &len);
|
||||
(char *) ¤t, &len);
|
||||
if (current < size) {
|
||||
len = sizeof(int);
|
||||
setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
|
||||
@@ -220,7 +215,7 @@ TclCreateSocketAddress(
|
||||
* We found some problems when using AI_ADDRCONFIG, e.g. on systems that
|
||||
* have no networking besides the loopback interface and want to resolve
|
||||
* localhost. See [Bugs 3385024, 3382419, 3382431]. As the advantage of
|
||||
* using AI_ADDRCONFIG is probably low even in situations where it works,
|
||||
* using AI_ADDRCONFIG in situations where it works, is probably low,
|
||||
* we'll leave it out for now. After all, it is just an optimisation.
|
||||
*
|
||||
* Missing on: OpenBSD, NetBSD.
|
||||
@@ -305,20 +300,16 @@ TclCreateSocketAddress(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Channel
|
||||
Tcl_OpenTcpServer(
|
||||
Tcl_Interp *interp,
|
||||
int port,
|
||||
const char *host,
|
||||
Tcl_TcpAcceptProc *acceptProc,
|
||||
ClientData callbackData)
|
||||
Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
|
||||
const char *host, Tcl_TcpAcceptProc *acceptProc,
|
||||
ClientData callbackData)
|
||||
{
|
||||
char portbuf[TCL_INTEGER_SPACE];
|
||||
|
||||
TclFormatInt(portbuf, port);
|
||||
|
||||
return Tcl_OpenTcpServerEx(interp, portbuf, host, TCL_TCPSERVER_REUSEADDR,
|
||||
acceptProc, callbackData);
|
||||
acceptProc, callbackData);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+36
-33
@@ -57,7 +57,7 @@ typedef struct FilesystemRecord {
|
||||
* this information each time the corresponding epoch counter changes.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ThreadSpecificData {
|
||||
int initialized;
|
||||
size_t cwdPathEpoch;
|
||||
size_t filesystemEpoch;
|
||||
@@ -245,7 +245,7 @@ static Tcl_ThreadDataKey fsDataKey;
|
||||
* code.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct FsDivertLoad {
|
||||
Tcl_LoadHandle loadHandle;
|
||||
Tcl_FSUnloadFileProc *unloadProcPtr;
|
||||
Tcl_Obj *divertedFile;
|
||||
@@ -412,6 +412,7 @@ Tcl_GetCwd(
|
||||
return Tcl_DStringValue(cwdPtr);
|
||||
}
|
||||
|
||||
/* Obsolete */
|
||||
int
|
||||
Tcl_EvalFile(
|
||||
Tcl_Interp *interp, /* Interpreter in which to process file. */
|
||||
@@ -610,7 +611,6 @@ FsRecacheFilesystemList(void)
|
||||
|
||||
while (toFree) {
|
||||
FilesystemRecord *next = toFree->nextPtr;
|
||||
|
||||
toFree->fsPtr = NULL;
|
||||
ckfree(toFree);
|
||||
toFree = next;
|
||||
@@ -672,6 +672,7 @@ TclFSEpoch(void)
|
||||
|
||||
return tsdPtr->filesystemEpoch;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* If non-NULL, clientData is owned by us and must be freed later.
|
||||
@@ -783,9 +784,7 @@ TclFinalizeFilesystem(void)
|
||||
while (fsRecPtr != NULL) {
|
||||
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
|
||||
|
||||
/*
|
||||
* The native filesystem is static, so we don't free it.
|
||||
*/
|
||||
/* The native filesystem is static, so we don't free it. */
|
||||
|
||||
if (fsRecPtr != &nativeFilesystemRecord) {
|
||||
ckfree(fsRecPtr);
|
||||
@@ -830,6 +829,15 @@ TclResetFilesystem(void)
|
||||
if (++theFilesystemEpoch == 0) {
|
||||
++theFilesystemEpoch;
|
||||
}
|
||||
|
||||
#ifdef _WIN32
|
||||
/*
|
||||
* Cleans up the win32 API filesystem proc lookup table. This must happen
|
||||
* very late in finalization so that deleting of copied dlls can occur.
|
||||
*/
|
||||
|
||||
TclWinResetInterfaces();
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -939,7 +947,7 @@ Tcl_FSRegister(
|
||||
|
||||
int
|
||||
Tcl_FSUnregister(
|
||||
const Tcl_Filesystem *fsPtr)/* The filesystem record to remove. */
|
||||
const Tcl_Filesystem *fsPtr) /* The filesystem record to remove. */
|
||||
{
|
||||
int retVal = TCL_ERROR;
|
||||
FilesystemRecord *fsRecPtr;
|
||||
@@ -1225,7 +1233,7 @@ FsAddMountsToGlobResult(
|
||||
|
||||
len--;
|
||||
}
|
||||
len++; /* account for '/' in the mElt [Bug 1602539] */
|
||||
len++; /* account for '/' in the mElt [Bug 1602539] */
|
||||
mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len);
|
||||
Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
|
||||
}
|
||||
@@ -1395,7 +1403,7 @@ TclFSNormalizeToUniquePath(
|
||||
* Call each of the "normalise path" functions in succession. This is a
|
||||
* special case, in which if we have a native filesystem handler, we call
|
||||
* it first. This is because the root of Tcl's filesystem is always a
|
||||
* native filesystem (i.e., '/' on unix is native).
|
||||
* native filesystem (i.e. '/' on unix is native).
|
||||
*/
|
||||
|
||||
firstFsRecPtr = FsGetFirstFilesystem();
|
||||
@@ -1517,7 +1525,7 @@ TclGetOpenModeEx(
|
||||
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
|
||||
|
||||
/*
|
||||
* Check for the simpler fopen-like access modes (e.g., "r"). They are
|
||||
* Check for the simpler fopen-like access modes (e.g. "r"). They are
|
||||
* distinguished from the POSIX access modes by the presence of a
|
||||
* lower-case first letter.
|
||||
*/
|
||||
@@ -1754,7 +1762,7 @@ Tcl_FSEvalFileEx(
|
||||
* this cross-platform to allow for scripted documents. [Bug: 2040]
|
||||
*/
|
||||
|
||||
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");
|
||||
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
|
||||
|
||||
/*
|
||||
* If the encoding is specified, set it for the channel. Else don't touch
|
||||
@@ -1889,7 +1897,7 @@ TclNREvalFile(
|
||||
* this cross-platform to allow for scripted documents. [Bug: 2040]
|
||||
*/
|
||||
|
||||
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");
|
||||
Tcl_SetChannelOption(interp, chan, "-eofchar", "\32");
|
||||
|
||||
/*
|
||||
* If the encoding is specified, set it for the channel. Else don't touch
|
||||
@@ -2663,7 +2671,6 @@ Tcl_FSGetCwd(
|
||||
fsRecPtr = fsRecPtr->nextPtr) {
|
||||
ClientData retCd;
|
||||
TclFSGetCwdProc2 *proc2;
|
||||
|
||||
if (fsRecPtr->fsPtr->getCwdProc == NULL) {
|
||||
continue;
|
||||
}
|
||||
@@ -3136,8 +3143,8 @@ Tcl_FSLoadFile(
|
||||
* Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
|
||||
* error) yet somehow trash some internal data structures which prevents the
|
||||
* second and further shared libraries from getting properly loaded. Only the
|
||||
* first is ok. We try to get around the issue by not unlinking, i.e.,
|
||||
* emulating the behaviour of the older HPUX which denied removal.
|
||||
* first is ok. We try to get around the issue by not unlinking,
|
||||
* i.e. emulating the behaviour of the older HPUX which denied removal.
|
||||
*
|
||||
* Doing the unlink is also an issue within docker containers, whose AUFS
|
||||
* bungles this as well, see
|
||||
@@ -3155,30 +3162,28 @@ Tcl_FSLoadFile(
|
||||
*/
|
||||
|
||||
int
|
||||
TclSkipUnlink(
|
||||
Tcl_Obj *shlibFile)
|
||||
TclSkipUnlink (Tcl_Obj* shlibFile)
|
||||
{
|
||||
/*
|
||||
* Order of testing:
|
||||
/* Order of testing:
|
||||
* 1. On hpux we generally want to skip unlink in general
|
||||
*
|
||||
* Outside of hpux then:
|
||||
* 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present,
|
||||
* non-empty, => int)
|
||||
* 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
|
||||
* 3. For general AUFS environment (statfs, if available).
|
||||
*
|
||||
* Ad 2: This variable can disable/override the AUFS detection, i.e. for
|
||||
* testing if a newer AUFS does not have the bug any more.
|
||||
* testing if a newer AUFS does not have the bug any more.
|
||||
*
|
||||
* Ad 3: This is conditionally compiled in. Condition currently must be
|
||||
* set manually. This part needs proper tests in the configure(.in).
|
||||
* Ad 3: This is conditionally compiled in. Condition currently must be set manually.
|
||||
* This part needs proper tests in the configure(.in).
|
||||
*/
|
||||
|
||||
#ifdef hpux
|
||||
return 1;
|
||||
#else
|
||||
char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
|
||||
char* skipstr;
|
||||
|
||||
skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
|
||||
if (skipstr && (skipstr[0] != '\0')) {
|
||||
return atoi(skipstr);
|
||||
}
|
||||
@@ -3187,8 +3192,7 @@ TclSkipUnlink(
|
||||
#ifndef NO_FSTATFS
|
||||
{
|
||||
struct statfs fs;
|
||||
/*
|
||||
* Have fstatfs. May not have the AUFS super magic ... Indeed our build
|
||||
/* Have fstatfs. May not have the AUFS super magic ... Indeed our build
|
||||
* box is too old to have it directly in the headers. Define taken from
|
||||
* http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
|
||||
* http://aufs.sourceforge.net/
|
||||
@@ -3205,10 +3209,8 @@ TclSkipUnlink(
|
||||
#endif /* ... NO_FSTATFS */
|
||||
#endif /* ... TCL_TEMPLOAD_NO_UNLINK */
|
||||
|
||||
/*
|
||||
* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
|
||||
* Don't skip
|
||||
*/
|
||||
/* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
|
||||
* Don't skip */
|
||||
return 0;
|
||||
#endif /* hpux */
|
||||
}
|
||||
@@ -3413,8 +3415,9 @@ Tcl_LoadFile(
|
||||
* avoids any worries about leaving the copy laying around on exit.
|
||||
*/
|
||||
|
||||
if (!TclSkipUnlink(copyToPtr) &&
|
||||
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
|
||||
if (
|
||||
!TclSkipUnlink (copyToPtr) &&
|
||||
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
|
||||
Tcl_DecrRefCount(copyToPtr);
|
||||
|
||||
/*
|
||||
|
||||
@@ -101,7 +101,6 @@ typedef struct {
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
#undef Tcl_GetIndexFromObj
|
||||
int
|
||||
Tcl_GetIndexFromObj(
|
||||
@@ -138,7 +137,6 @@ Tcl_GetIndexFromObj(
|
||||
return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
|
||||
msg, flags, indexPtr);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -876,8 +874,7 @@ Tcl_WrongNumArgs(
|
||||
* NULL. */
|
||||
{
|
||||
Tcl_Obj *objPtr;
|
||||
int i, len, elemLen;
|
||||
char flags;
|
||||
int i, len, elemLen, flags;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
const char *elementStr;
|
||||
|
||||
|
||||
+56
-68
@@ -50,7 +50,7 @@ declare 6 {
|
||||
declare 7 {
|
||||
int TclCopyAndCollapse(int count, const char *src, char *dst)
|
||||
}
|
||||
declare 8 {deprecated {}} {
|
||||
declare 8 {
|
||||
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
|
||||
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
|
||||
}
|
||||
@@ -73,7 +73,7 @@ declare 11 {
|
||||
declare 12 {
|
||||
void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
|
||||
}
|
||||
# Removed in 8.5:
|
||||
# Removed in 8.5
|
||||
#declare 13 {
|
||||
# int TclDoGlob(Tcl_Interp *interp, char *separators,
|
||||
# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
|
||||
@@ -88,7 +88,7 @@ declare 14 {
|
||||
declare 16 {
|
||||
void TclExprFloatError(Tcl_Interp *interp, double value)
|
||||
}
|
||||
# Removed in 8.4:
|
||||
# Removed in 8.4
|
||||
#declare 17 {
|
||||
# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
|
||||
#}
|
||||
@@ -114,7 +114,7 @@ declare 23 {
|
||||
}
|
||||
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
|
||||
declare 24 {
|
||||
int TclFormatInt(char *buffer, Tcl_WideInt n)
|
||||
int TclFormatInt(char *buffer, long n)
|
||||
}
|
||||
declare 25 {
|
||||
void TclFreePackageInfo(Interp *iPtr)
|
||||
@@ -123,7 +123,7 @@ declare 25 {
|
||||
# declare 26 {
|
||||
# char *TclGetCwd(Tcl_Interp *interp)
|
||||
# }
|
||||
# Removed in 8.5:
|
||||
# Removed in 8.5
|
||||
#declare 27 {
|
||||
# int TclGetDate(char *p, unsigned long now, long zone,
|
||||
# unsigned long *timePtr)
|
||||
@@ -147,7 +147,7 @@ declare 32 {
|
||||
int TclGetFrame(Tcl_Interp *interp, const char *str,
|
||||
CallFrame **framePtrPtr)
|
||||
}
|
||||
# Removed in 8.5:
|
||||
# Removed in Tcl 8.5
|
||||
#declare 33 {
|
||||
# TclCmdProcType TclGetInterpProc(void)
|
||||
#}
|
||||
@@ -160,7 +160,7 @@ declare 34 {
|
||||
# Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
|
||||
# int flags)
|
||||
#}
|
||||
# Removed in 8.6a2:
|
||||
# Removed in 8.6a2
|
||||
#declare 36 {
|
||||
# int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
|
||||
#}
|
||||
@@ -185,9 +185,9 @@ declare 41 {
|
||||
declare 42 {
|
||||
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
}
|
||||
# Removed in 8.5a2:
|
||||
# Removed in Tcl 8.5a2
|
||||
#declare 43 {
|
||||
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
|
||||
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
|
||||
# int flags)
|
||||
#}
|
||||
declare 44 {
|
||||
@@ -220,14 +220,14 @@ declare 50 {
|
||||
declare 51 {
|
||||
int TclInterpInit(Tcl_Interp *interp)
|
||||
}
|
||||
# Removed in 8.5a2:
|
||||
# Removed in Tcl 8.5a2
|
||||
#declare 52 {
|
||||
# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
|
||||
# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
|
||||
# int flags)
|
||||
#}
|
||||
declare 53 {
|
||||
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
|
||||
int argc, const char **argv)
|
||||
int argc, CONST84 char **argv)
|
||||
}
|
||||
declare 54 {
|
||||
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
|
||||
@@ -273,7 +273,7 @@ declare 64 {
|
||||
int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
|
||||
int flags)
|
||||
}
|
||||
# Removed in 8.5a2:
|
||||
# Removed in Tcl 8.5a2
|
||||
#declare 65 {
|
||||
# int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
|
||||
# Tcl_Obj *const objv[], int flags)
|
||||
@@ -313,7 +313,9 @@ declare 75 {
|
||||
declare 76 {
|
||||
unsigned long TclpGetSeconds(void)
|
||||
}
|
||||
declare 77 {deprecated {}} {
|
||||
|
||||
# deprecated
|
||||
declare 77 {
|
||||
void TclpGetTime(Tcl_Time *time)
|
||||
}
|
||||
# Removed in 8.6:
|
||||
@@ -355,7 +357,7 @@ declare 81 {
|
||||
# declare 87 {
|
||||
# void TclPlatformInit(Tcl_Interp *interp)
|
||||
# }
|
||||
declare 88 {deprecated {}} {
|
||||
declare 88 {
|
||||
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
|
||||
const char *name1, const char *name2, int flags)
|
||||
}
|
||||
@@ -378,7 +380,7 @@ declare 92 {
|
||||
declare 93 {
|
||||
void TclProcDeleteProc(ClientData clientData)
|
||||
}
|
||||
# Removed in 8.5:
|
||||
# Removed in Tcl 8.5:
|
||||
#declare 94 {
|
||||
# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
|
||||
# int argc, const char **argv)
|
||||
@@ -417,7 +419,7 @@ declare 103 {
|
||||
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
|
||||
int *portPtr)
|
||||
}
|
||||
declare 104 {deprecated {}} {
|
||||
declare 104 {
|
||||
int TclSockMinimumBuffersOld(int sock, int size)
|
||||
}
|
||||
# Replaced by Tcl_FSStat in 8.4:
|
||||
@@ -453,26 +455,26 @@ declare 111 {
|
||||
Tcl_ResolveCompiledVarProc *compiledVarProc)
|
||||
}
|
||||
declare 112 {
|
||||
int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 113 {
|
||||
Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
|
||||
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
|
||||
}
|
||||
declare 114 {
|
||||
void TclDeleteNamespace(Tcl_Namespace *nsPtr)
|
||||
void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
|
||||
}
|
||||
declare 115 {
|
||||
int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int resetListFirst)
|
||||
}
|
||||
declare 116 {
|
||||
Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags)
|
||||
}
|
||||
declare 117 {
|
||||
Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags)
|
||||
}
|
||||
declare 118 {
|
||||
@@ -488,28 +490,28 @@ declare 120 {
|
||||
Tcl_Namespace *contextNsPtr, int flags)
|
||||
}
|
||||
declare 121 {
|
||||
int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern)
|
||||
}
|
||||
declare 122 {
|
||||
Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 123 {
|
||||
void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
|
||||
void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
|
||||
Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 124 {
|
||||
Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
|
||||
Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
|
||||
}
|
||||
declare 125 {
|
||||
Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
|
||||
Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
|
||||
}
|
||||
declare 126 {
|
||||
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
|
||||
Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 127 {
|
||||
int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int allowOverwrite)
|
||||
}
|
||||
declare 128 {
|
||||
@@ -530,7 +532,7 @@ declare 131 {
|
||||
declare 132 {
|
||||
int TclpHasSockets(Tcl_Interp *interp)
|
||||
}
|
||||
declare 133 {deprecated {}} {
|
||||
declare 133 {
|
||||
struct tm *TclpGetDate(const time_t *time, int useGMT)
|
||||
}
|
||||
# Removed in 8.5
|
||||
@@ -548,7 +550,7 @@ declare 133 {deprecated {}} {
|
||||
# int TclpChdir(const char *dirName)
|
||||
#}
|
||||
declare 138 {
|
||||
const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
|
||||
CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
|
||||
}
|
||||
#declare 139 {
|
||||
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
|
||||
@@ -560,7 +562,7 @@ declare 138 {
|
||||
#}
|
||||
# This is used by TclX, but should otherwise be considered private
|
||||
declare 141 {
|
||||
const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
|
||||
CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
|
||||
}
|
||||
declare 142 {
|
||||
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
@@ -623,10 +625,12 @@ declare 156 {
|
||||
declare 157 {
|
||||
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
|
||||
}
|
||||
declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
|
||||
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
|
||||
declare 158 {
|
||||
void TclSetStartupScriptFileName(const char *filename)
|
||||
}
|
||||
declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
|
||||
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
|
||||
declare 159 {
|
||||
const char *TclGetStartupScriptFileName(void)
|
||||
}
|
||||
#declare 160 {
|
||||
@@ -672,10 +676,13 @@ declare 166 {
|
||||
int index, Tcl_Obj *valuePtr)
|
||||
}
|
||||
|
||||
declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
|
||||
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
|
||||
# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
|
||||
declare 167 {
|
||||
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
|
||||
}
|
||||
declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
|
||||
# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
|
||||
declare 168 {
|
||||
Tcl_Obj *TclGetStartupScriptPath(void)
|
||||
}
|
||||
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
|
||||
@@ -723,11 +730,12 @@ declare 177 {
|
||||
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
|
||||
const char *operation, const char *reason)
|
||||
}
|
||||
# TIP 338 made these public - now declared in tcl.h too
|
||||
declare 178 {
|
||||
void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
|
||||
void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
|
||||
}
|
||||
declare 179 {
|
||||
Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
|
||||
Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
|
||||
}
|
||||
|
||||
# REMOVED
|
||||
@@ -740,10 +748,12 @@ declare 179 {
|
||||
# const char *file, int line)
|
||||
#}
|
||||
|
||||
declare 182 {deprecated {}} {
|
||||
# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
|
||||
|
||||
declare 182 {
|
||||
struct tm *TclpLocaltime(const time_t *clock)
|
||||
}
|
||||
declare 183 {deprecated {}} {
|
||||
declare 183 {
|
||||
struct tm *TclpGmtime(const time_t *clock)
|
||||
}
|
||||
|
||||
@@ -927,7 +937,10 @@ declare 234 {
|
||||
declare 235 {
|
||||
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
|
||||
}
|
||||
declare 236 {deprecated {use Tcl_BackgroundException}} {
|
||||
|
||||
|
||||
# TIP 337 made this one public
|
||||
declare 236 {
|
||||
void TclBackgroundException(Tcl_Interp *interp, int code)
|
||||
}
|
||||
|
||||
@@ -998,32 +1011,6 @@ declare 251 {
|
||||
int TclRegisterLiteral(void *envPtr,
|
||||
const char *bytes, int length, int flags)
|
||||
}
|
||||
|
||||
# Exporting of the internal API to variables.
|
||||
|
||||
declare 252 {
|
||||
Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
|
||||
const int flags)
|
||||
}
|
||||
declare 253 {
|
||||
Tcl_Obj *TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
|
||||
Tcl_Obj *newValuePtr, const int flags)
|
||||
}
|
||||
declare 254 {
|
||||
Tcl_Obj *TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
|
||||
Tcl_Obj *incrPtr, const int flags)
|
||||
}
|
||||
declare 255 {
|
||||
int TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr,
|
||||
Tcl_Obj *myNamePtr, int myFlags)
|
||||
}
|
||||
declare 256 {
|
||||
int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
|
||||
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
|
||||
}
|
||||
|
||||
##############################################################################
|
||||
|
||||
@@ -1077,7 +1064,7 @@ declare 9 win {
|
||||
declare 10 win {
|
||||
Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
}
|
||||
# Removed in 8.3.1 (for Win32s only):
|
||||
# Removed in 8.3.1 (for Win32s only)
|
||||
#declare 10 win {
|
||||
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
|
||||
#}
|
||||
@@ -1127,6 +1114,7 @@ declare 19 win {
|
||||
declare 20 win {
|
||||
void TclWinAddProcess(HANDLE hProcess, DWORD id)
|
||||
}
|
||||
# new for 8.4.20+/8.5.12+
|
||||
declare 21 win {
|
||||
char *TclpInetNtoa(struct in_addr addr)
|
||||
}
|
||||
|
||||
+168
-235
@@ -160,13 +160,13 @@ typedef struct Tcl_ResolvedVarInfo {
|
||||
} Tcl_ResolvedVarInfo;
|
||||
|
||||
typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
|
||||
const char *name, int length, Tcl_Namespace *context,
|
||||
CONST84 char *name, int length, Tcl_Namespace *context,
|
||||
Tcl_ResolvedVarInfo **rPtr);
|
||||
|
||||
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
|
||||
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
|
||||
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
|
||||
|
||||
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
|
||||
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
|
||||
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
|
||||
|
||||
typedef struct Tcl_ResolverInfo {
|
||||
@@ -265,7 +265,7 @@ typedef struct Namespace {
|
||||
* strings; values have type (Namespace *). If
|
||||
* NULL, there are no children. */
|
||||
#endif
|
||||
unsigned long nsId; /* Unique id for the namespace. */
|
||||
long nsId; /* Unique id for the namespace. */
|
||||
Tcl_Interp *interp; /* The interpreter containing this
|
||||
* namespace. */
|
||||
int flags; /* OR-ed combination of the namespace status
|
||||
@@ -274,7 +274,7 @@ typedef struct Namespace {
|
||||
* frames for this namespace that are on the
|
||||
* Tcl call stack. The namespace won't be
|
||||
* freed until activationCount becomes zero. */
|
||||
unsigned int refCount; /* Count of references by namespaceName
|
||||
int refCount; /* Count of references by namespaceName
|
||||
* objects. The namespace can't be freed until
|
||||
* refCount becomes zero. */
|
||||
Tcl_HashTable cmdTable; /* Contains all the commands currently
|
||||
@@ -299,12 +299,12 @@ typedef struct Namespace {
|
||||
* registered using "namespace export". */
|
||||
int maxExportPatterns; /* Mumber of export patterns for which space
|
||||
* is currently allocated. */
|
||||
unsigned int cmdRefEpoch; /* Incremented if a newly added command
|
||||
int cmdRefEpoch; /* Incremented if a newly added command
|
||||
* shadows a command for which this namespace
|
||||
* has already cached a Command* pointer; this
|
||||
* causes all its cached Command* pointers to
|
||||
* be invalidated. */
|
||||
unsigned int resolverEpoch; /* Incremented whenever (a) the name
|
||||
int resolverEpoch; /* Incremented whenever (a) the name
|
||||
* resolution rules change for this namespace
|
||||
* or (b) a newly added command shadows a
|
||||
* command that is compiled to bytecodes. This
|
||||
@@ -331,7 +331,7 @@ typedef struct Namespace {
|
||||
* LookupCompiledLocal to resolve variable
|
||||
* references within the namespace at compile
|
||||
* time. */
|
||||
unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
|
||||
int exportLookupEpoch; /* Incremented whenever a command is added to
|
||||
* a namespace, removed from a namespace or
|
||||
* the exports of a namespace are changed.
|
||||
* Allows TIP#112-driven command lists to be
|
||||
@@ -426,13 +426,13 @@ struct NamespacePathEntry {
|
||||
*/
|
||||
|
||||
typedef struct EnsembleConfig {
|
||||
Namespace *nsPtr; /* The namespace backing this ensemble up. */
|
||||
Namespace *nsPtr; /* The namspace backing this ensemble up. */
|
||||
Tcl_Command token; /* The token for the command that provides
|
||||
* ensemble support for the namespace, or NULL
|
||||
* if the command has been deleted (or never
|
||||
* existed; the global namespace never has an
|
||||
* ensemble command.) */
|
||||
unsigned int epoch; /* The epoch at which this ensemble's table of
|
||||
int epoch; /* The epoch at which this ensemble's table of
|
||||
* exported commands is valid. */
|
||||
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
|
||||
* consistent points, this will have the same
|
||||
@@ -545,7 +545,7 @@ typedef struct CommandTrace {
|
||||
struct CommandTrace *nextPtr;
|
||||
/* Next in list of traces associated with a
|
||||
* particular command. */
|
||||
size_t refCount; /* Used to ensure this structure is not
|
||||
int refCount; /* Used to ensure this structure is not
|
||||
* deleted too early. Keeps track of how many
|
||||
* pieces of code have a pointer to this
|
||||
* structure. */
|
||||
@@ -618,7 +618,7 @@ typedef struct Var {
|
||||
|
||||
typedef struct VarInHash {
|
||||
Var var;
|
||||
unsigned int refCount; /* Counts number of active uses of this
|
||||
int refCount; /* Counts number of active uses of this
|
||||
* variable: 1 for the entry in the hash
|
||||
* table, 1 for each additional variable whose
|
||||
* linkPtr points here, 1 for each nested
|
||||
@@ -950,7 +950,7 @@ typedef struct CompiledLocal {
|
||||
typedef struct Proc {
|
||||
struct Interp *iPtr; /* Interpreter for which this command is
|
||||
* defined. */
|
||||
unsigned int refCount; /* Reference count: 1 if still present in
|
||||
int refCount; /* Reference count: 1 if still present in
|
||||
* command table plus 1 for each call to the
|
||||
* procedure that is currently active. This
|
||||
* structure can be freed when refCount
|
||||
@@ -1067,7 +1067,7 @@ typedef struct AssocData {
|
||||
*/
|
||||
|
||||
typedef struct LocalCache {
|
||||
unsigned int refCount;
|
||||
int refCount;
|
||||
int numVars;
|
||||
Tcl_Obj *varName0;
|
||||
} LocalCache;
|
||||
@@ -1229,7 +1229,7 @@ typedef struct CmdFrame {
|
||||
typedef struct CFWord {
|
||||
CmdFrame *framePtr; /* CmdFrame to access. */
|
||||
int word; /* Index of the word in the command. */
|
||||
unsigned int refCount; /* Number of times the word is on the
|
||||
int refCount; /* Number of times the word is on the
|
||||
* stack. */
|
||||
} CFWord;
|
||||
|
||||
@@ -1357,7 +1357,7 @@ MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
|
||||
*/
|
||||
|
||||
#define TCL_TSD_INIT(keyPtr) \
|
||||
Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
|
||||
(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -1492,11 +1492,11 @@ typedef struct LiteralEntry {
|
||||
* NULL if end of chain. */
|
||||
Tcl_Obj *objPtr; /* Points to Tcl object that holds the
|
||||
* literal's bytes and length. */
|
||||
size_t refCount; /* If in an interpreter's global literal
|
||||
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, (size_t)-1. */
|
||||
* 0. If in a local literal table, -1. */
|
||||
Namespace *nsPtr; /* Namespace in which this literal is used. We
|
||||
* try to avoid sharing literal non-FQ command
|
||||
* names among different namespaces to reduce
|
||||
@@ -1516,7 +1516,7 @@ typedef struct LiteralTable {
|
||||
* table. */
|
||||
int rebuildSize; /* Enlarge table when numEntries gets to be
|
||||
* this large. */
|
||||
unsigned int mask; /* Mask value used in hashing function. */
|
||||
int mask; /* Mask value used in hashing function. */
|
||||
} LiteralTable;
|
||||
|
||||
/*
|
||||
@@ -1634,12 +1634,12 @@ typedef struct Command {
|
||||
* recreated). */
|
||||
Namespace *nsPtr; /* Points to the namespace containing this
|
||||
* command. */
|
||||
unsigned int refCount; /* 1 if in command hashtable plus 1 for each
|
||||
int refCount; /* 1 if in command hashtable plus 1 for each
|
||||
* reference from a CmdName Tcl object
|
||||
* representing a command's name in a ByteCode
|
||||
* instruction sequence. This structure can be
|
||||
* freed when refCount becomes zero. */
|
||||
unsigned int cmdEpoch; /* Incremented to invalidate any references
|
||||
int cmdEpoch; /* Incremented to invalidate any references
|
||||
* that point to this command when it is
|
||||
* renamed, deleted, hidden, or exposed. */
|
||||
CompileProc *compileProc; /* Procedure called to compile command. NULL
|
||||
@@ -1826,7 +1826,7 @@ typedef struct Interp {
|
||||
* unused space in interp was repurposed for
|
||||
* pluggable bytecode optimizers. The core
|
||||
* contains one optimizer, which can be
|
||||
* selectively overridden by extensions. */
|
||||
* selectively overriden by extensions. */
|
||||
} extra;
|
||||
|
||||
/*
|
||||
@@ -1862,7 +1862,6 @@ typedef struct Interp {
|
||||
* See Tcl_AppendResult code for details.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
char *appendResult; /* Storage space for results generated by
|
||||
* Tcl_AppendResult. Ckalloc-ed. NULL means
|
||||
* not yet allocated. */
|
||||
@@ -1870,11 +1869,6 @@ typedef struct Interp {
|
||||
* partialResult. */
|
||||
int appendUsed; /* Number of non-null bytes currently stored
|
||||
* at partialResult. */
|
||||
#else
|
||||
char *appendResultDontUse;
|
||||
int appendAvlDontUse;
|
||||
int appendUsedDontUse;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Information about packages. Used only in tclPkg.c.
|
||||
@@ -1936,14 +1930,8 @@ typedef struct Interp {
|
||||
* string. Returned by Tcl_ObjSetVar2 when
|
||||
* variable traces change a variable in a
|
||||
* gross way. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
# if !defined(TCL_NO_DEPRECATED)
|
||||
char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
|
||||
char resultSpace[TCL_RESULT_SIZE+1];
|
||||
/* Static space holding small results. */
|
||||
# else
|
||||
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
|
||||
# endif
|
||||
#endif
|
||||
Tcl_Obj *objResultPtr; /* If the last command returned an object
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
@@ -2253,7 +2241,7 @@ typedef struct Interp {
|
||||
* use the rand() or srand() functions.
|
||||
* SAFE_INTERP: Non zero means that the current interp is a safe
|
||||
* interp (i.e. it has only the safe commands installed,
|
||||
* less privilege than a regular interp).
|
||||
* less priviledge than a regular interp).
|
||||
* INTERP_DEBUG_FRAME: Used for switching on various extra interpreter
|
||||
* debug/info mechanisms (e.g. info frame eval/uplevel
|
||||
* tracing) which are performance intensive.
|
||||
@@ -2386,7 +2374,7 @@ typedef enum TclEolTranslation {
|
||||
*/
|
||||
|
||||
typedef struct List {
|
||||
unsigned int refCount;
|
||||
int refCount;
|
||||
int maxElemCount; /* Total number of element array slots. */
|
||||
int elemCount; /* Current number of list elements. */
|
||||
int canonicalFlag; /* Set if the string representation was
|
||||
@@ -2394,7 +2382,7 @@ typedef struct List {
|
||||
* be ignored if there is no string rep at
|
||||
* all.*/
|
||||
Tcl_Obj *elements; /* First list element; the struct is grown to
|
||||
* accommodate all elements. */
|
||||
* accomodate all elements. */
|
||||
} List;
|
||||
|
||||
#define LIST_MAX \
|
||||
@@ -2447,46 +2435,32 @@ typedef struct List {
|
||||
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
|
||||
|
||||
/*
|
||||
* Macros providing a faster path to booleans and integers:
|
||||
* Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
|
||||
* and TclGetIntForIndex.
|
||||
* Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
|
||||
* Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
|
||||
*
|
||||
* WARNING: these macros eval their args more than once.
|
||||
*/
|
||||
|
||||
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
|
||||
: ((objPtr)->typePtr == &tclBooleanType) \
|
||||
? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
|
||||
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
|
||||
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
#define TclGetLongFromObj(interp, objPtr, longPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
|
||||
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
|
||||
#else
|
||||
#define TclGetLongFromObj(interp, objPtr, longPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \
|
||||
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX)) \
|
||||
? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
|
||||
#endif
|
||||
|
||||
#if (LONG_MAX == INT_MAX)
|
||||
#define TclGetIntFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
&& (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \
|
||||
&& (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX)) \
|
||||
? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
|
||||
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
|
||||
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
&& (objPtr)->internalRep.wideValue >= INT_MIN \
|
||||
&& (objPtr)->internalRep.wideValue <= INT_MAX) \
|
||||
? ((*(idxPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
|
||||
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
|
||||
#else
|
||||
#define TclGetIntFromObj(interp, objPtr, intPtr) \
|
||||
Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
|
||||
#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \
|
||||
TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Macro used to save a function call for common uses of
|
||||
@@ -2496,11 +2470,21 @@ typedef struct List {
|
||||
* Tcl_WideInt *wideIntPtr);
|
||||
*/
|
||||
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? (*(wideIntPtr) = (Tcl_WideInt) \
|
||||
((objPtr)->internalRep.wideValue), TCL_OK) : \
|
||||
((objPtr)->internalRep.longValue), TCL_OK) : \
|
||||
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
|
||||
#else /* !TCL_WIDE_INT_IS_LONG */
|
||||
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
|
||||
(((objPtr)->typePtr == &tclWideIntType) \
|
||||
? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
|
||||
((objPtr)->typePtr == &tclIntType) \
|
||||
? (*(wideIntPtr) = (Tcl_WideInt) \
|
||||
((objPtr)->internalRep.longValue), TCL_OK) : \
|
||||
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
|
||||
#endif /* TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
/*
|
||||
* Flag values for TclTraceDictPath().
|
||||
@@ -2512,13 +2496,13 @@ typedef struct List {
|
||||
* tip of the path, so duplication of shared objects should be done along the
|
||||
* way.
|
||||
*
|
||||
* DICT_PATH_EXISTS indicates that we are performing an existence test and a
|
||||
* DICT_PATH_EXISTS indicates that we are performing an existance test and a
|
||||
* lookup failure should therefore not be an error. If (and only if) this flag
|
||||
* is set, TclTraceDictPath() will return the special value
|
||||
* DICT_PATH_NON_EXISTENT if the path is not traceable.
|
||||
*
|
||||
* DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set)
|
||||
* indicates that we are to create non-existent dictionaries on the path.
|
||||
* indicates that we are to create non-existant dictionaries on the path.
|
||||
*/
|
||||
|
||||
#define DICT_PATH_READ 0
|
||||
@@ -2624,7 +2608,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
|
||||
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
|
||||
Tcl_Encoding *encodingPtr);
|
||||
|
||||
/*
|
||||
@@ -2636,9 +2620,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *leng
|
||||
*/
|
||||
|
||||
typedef struct ProcessGlobalValue {
|
||||
unsigned int epoch; /* Epoch counter to detect changes in the
|
||||
size_t epoch; /* Epoch counter to detect changes in the
|
||||
* master value. */
|
||||
unsigned int numBytes; /* Length of the master string. */
|
||||
size_t numBytes; /* Length of the master string. */
|
||||
char *value; /* The master string value. */
|
||||
Tcl_Encoding encoding; /* system encoding when master string was
|
||||
* initialized. */
|
||||
@@ -2726,6 +2710,9 @@ MODULE_SCOPE const Tcl_ObjType tclDictType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclStringType;
|
||||
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
MODULE_SCOPE const Tcl_ObjType tclWideIntType;
|
||||
#endif
|
||||
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
|
||||
MODULE_SCOPE Tcl_ObjType tclCmdNameType;
|
||||
|
||||
@@ -2775,7 +2762,6 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
|
||||
@@ -2904,8 +2890,6 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
|
||||
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
|
||||
MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
|
||||
Tcl_Obj *value2Ptr);
|
||||
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
|
||||
int *loc);
|
||||
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
|
||||
@@ -2915,25 +2899,12 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
|
||||
Tcl_Obj *originObjPtr);
|
||||
MODULE_SCOPE int TclConvertElement(const char *src, int length,
|
||||
char *dst, int flags);
|
||||
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *nameNamespacePtr,
|
||||
Tcl_Namespace *ensembleNamespacePtr,
|
||||
int flags);
|
||||
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
|
||||
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
|
||||
const char *dict, int dictLength,
|
||||
const char **elementPtr, const char **nextPtr,
|
||||
int *sizePtr, int *literalPtr);
|
||||
/* TIP #280 - Modified token based evaluation, with line information. */
|
||||
/* TIP #280 - Modified token based evulation, with line information. */
|
||||
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
|
||||
int numBytes, int flags, int line,
|
||||
int *clNextOuter, const char *outerScript);
|
||||
@@ -2956,8 +2927,6 @@ MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
|
||||
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
|
||||
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv, int objc, int *objcPtr);
|
||||
MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp,
|
||||
Tcl_Namespace *namespacePtr);
|
||||
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
|
||||
MODULE_SCOPE void TclFinalizeAsync(void);
|
||||
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
|
||||
@@ -2984,15 +2953,6 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
|
||||
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
|
||||
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
|
||||
const char *attributeName, int *indexPtr);
|
||||
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
Tcl_ObjCmdProc *nreProc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
|
||||
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
const char *encodingName);
|
||||
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
|
||||
@@ -3001,8 +2961,7 @@ MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
|
||||
int *modePtr, int flags);
|
||||
MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr);
|
||||
MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *value, int *code);
|
||||
MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, ClientData *clientDataPtr,
|
||||
@@ -3037,9 +2996,6 @@ MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE void TclInitAlloc(void);
|
||||
MODULE_SCOPE void TclInitBignumFromLong(mp_int *, long);
|
||||
MODULE_SCOPE void TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
|
||||
MODULE_SCOPE void TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
|
||||
MODULE_SCOPE void TclInitDbCkalloc(void);
|
||||
MODULE_SCOPE void TclInitDoubleConversion(void);
|
||||
MODULE_SCOPE void TclInitEmbeddedConfigurationInformation(
|
||||
@@ -3065,8 +3021,6 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n,
|
||||
int *lines, Tcl_Obj *const *elems);
|
||||
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
|
||||
int toIdx);
|
||||
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
|
||||
@@ -3121,7 +3075,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
|
||||
int stackSize, int flags);
|
||||
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
|
||||
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
|
||||
unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
|
||||
size_t *lengthPtr, Tcl_Encoding *encodingPtr);
|
||||
MODULE_SCOPE void TclpInitLock(void);
|
||||
MODULE_SCOPE void TclpInitPlatform(void);
|
||||
MODULE_SCOPE void TclpInitUnlock(void);
|
||||
@@ -3155,11 +3109,12 @@ MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
Tcl_PathPart portion);
|
||||
MODULE_SCOPE char * TclpReadlink(const char *fileName,
|
||||
Tcl_DString *linkPtr);
|
||||
MODULE_SCOPE void TclpSetInterfaces(void);
|
||||
MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp);
|
||||
MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
|
||||
MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
|
||||
void *data);
|
||||
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
|
||||
MODULE_SCOPE void TclpThreadExit(int status);
|
||||
MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex);
|
||||
MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
|
||||
MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
|
||||
@@ -3168,7 +3123,7 @@ MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
|
||||
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
|
||||
int *quantifiersFoundPtr);
|
||||
MODULE_SCOPE int TclScanElement(const char *string, int length,
|
||||
char *flagPtr);
|
||||
int *flagPtr);
|
||||
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
|
||||
Tcl_Obj *cmdPrefix);
|
||||
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
|
||||
@@ -3185,10 +3140,20 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
|
||||
Tcl_Obj *bad, Tcl_Obj *fix);
|
||||
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
|
||||
int numBytes);
|
||||
MODULE_SCOPE int TclStringCatObjv(Tcl_Interp *interp, int inPlace,
|
||||
int objc, Tcl_Obj *const objv[],
|
||||
Tcl_Obj **objPtrPtr);
|
||||
MODULE_SCOPE int TclStringFind(Tcl_Obj *needle, Tcl_Obj *haystack,
|
||||
int start);
|
||||
MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
|
||||
int last);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
|
||||
const char *pattern, int ptnLen, int flags);
|
||||
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
|
||||
Tcl_Obj *patternObj, int flags);
|
||||
MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int count, Tcl_Obj **objPtrPtr);
|
||||
MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes,
|
||||
int numBytes, int flags, int line,
|
||||
struct CompileEnv *envPtr);
|
||||
@@ -3200,13 +3165,10 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
|
||||
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
int count, int *tokensLeftPtr, int line,
|
||||
int *clNextOuter, const char *outerScript);
|
||||
MODULE_SCOPE int TclTrim(const char *bytes, int numBytes,
|
||||
const char *trim, int numTrim, int *trimRight);
|
||||
MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
|
||||
const char *trim, int numTrim);
|
||||
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
|
||||
const char *trim, int numTrim);
|
||||
MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
|
||||
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
|
||||
MODULE_SCOPE int TclUtfCount(int ch);
|
||||
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
|
||||
@@ -3256,7 +3218,7 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -3315,8 +3277,10 @@ MODULE_SCOPE int Tcl_AssembleObjCmd(ClientData clientData,
|
||||
MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int TclMakeEncodingCommandSafe(Tcl_Interp *interp);
|
||||
|
||||
MODULE_SCOPE int Tcl_EncodingObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -3554,12 +3518,6 @@ MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileClockClicksCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileClockReadingCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
@@ -3996,30 +3954,7 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
|
||||
struct CompileEnv *envPtr);
|
||||
|
||||
/*
|
||||
* Routines that provide the [string] ensemble functionality. Possible
|
||||
* candidates for public interface.
|
||||
*/
|
||||
|
||||
MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[], int flags);
|
||||
MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
|
||||
int start);
|
||||
MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
|
||||
int last);
|
||||
MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int count, int flags);
|
||||
MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int first, int count, Tcl_Obj *insertPtr,
|
||||
int flags);
|
||||
MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags);
|
||||
|
||||
/* Flag values for the [string] ensemble functions. */
|
||||
|
||||
#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
|
||||
#define TCL_STRING_IN_PLACE (1<<1)
|
||||
|
||||
/*
|
||||
* Functions defined in generic/tclVar.c and currently exported only for use
|
||||
* Functions defined in generic/tclVar.c and currenttly exported only for use
|
||||
* by the bytecode compiler and engine. Some of these could later be placed in
|
||||
* the public interface.
|
||||
*/
|
||||
@@ -4033,21 +3968,20 @@ MODULE_SCOPE Var * TclLookupArrayElement(Tcl_Interp *interp,
|
||||
const int flags, const char *msg,
|
||||
const int createPart1, const int createPart2,
|
||||
Var *arrayPtr, int index);
|
||||
MODULE_SCOPE Tcl_Obj * TclPtrGetVarIdx(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp,
|
||||
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, const int flags, int index);
|
||||
MODULE_SCOPE Tcl_Obj * TclPtrSetVarIdx(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp,
|
||||
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
|
||||
const int flags, int index);
|
||||
MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVarIdx(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp,
|
||||
Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
|
||||
const int flags, int index);
|
||||
MODULE_SCOPE int TclPtrObjMakeUpvarIdx(Tcl_Interp *interp,
|
||||
Var *otherPtr, Tcl_Obj *myNamePtr, int myFlags,
|
||||
int index);
|
||||
MODULE_SCOPE int TclPtrUnsetVarIdx(Tcl_Interp *interp, Var *varPtr,
|
||||
MODULE_SCOPE int TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
|
||||
Tcl_Obj *myNamePtr, int myFlags, int index);
|
||||
MODULE_SCOPE int TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr,
|
||||
Var *arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, const int flags,
|
||||
int index);
|
||||
@@ -4073,45 +4007,6 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
|
||||
|
||||
MODULE_SCOPE int TclFullFinalizationRequested(void);
|
||||
|
||||
/*
|
||||
* TIP #462.
|
||||
*/
|
||||
|
||||
/*
|
||||
* The following enum values give the status of a spawned process.
|
||||
*/
|
||||
|
||||
typedef enum TclProcessWaitStatus {
|
||||
TCL_PROCESS_ERROR = -1, /* Error waiting for process to exit */
|
||||
TCL_PROCESS_UNCHANGED = 0, /* No change since the last call. */
|
||||
TCL_PROCESS_EXITED = 1, /* Process has exited. */
|
||||
TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
|
||||
TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
|
||||
TCL_PROCESS_UNKNOWN_STATUS = 4
|
||||
/* Child wait status didn't make sense. */
|
||||
} TclProcessWaitStatus;
|
||||
|
||||
MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
|
||||
MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid);
|
||||
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
|
||||
int *codePtr, Tcl_Obj **msgObjPtr,
|
||||
Tcl_Obj **errorObjPtr);
|
||||
|
||||
/*
|
||||
* Utility routines for encoding index values as integers. Used by both
|
||||
* some of the command compilers and by [lsort] and [lsearch].
|
||||
*/
|
||||
|
||||
MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int before, int after, int *indexPtr);
|
||||
MODULE_SCOPE int TclIndexDecode(int encoded, int endValue);
|
||||
|
||||
/* Constants used in index value encoding routines. */
|
||||
#define TCL_INDEX_END (-2)
|
||||
#define TCL_INDEX_BEFORE (-1)
|
||||
#define TCL_INDEX_START (0)
|
||||
#define TCL_INDEX_AFTER (INT_MAX)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Macros used by the Tcl core to create and release Tcl objects.
|
||||
@@ -4444,13 +4339,13 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
|
||||
#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \
|
||||
do { \
|
||||
int _needed = (used) + (append); \
|
||||
if (_needed > TCL_MAX_TOKENS) { \
|
||||
int needed = (used) + (append); \
|
||||
if (needed > TCL_MAX_TOKENS) { \
|
||||
Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded", \
|
||||
TCL_MAX_TOKENS); \
|
||||
} \
|
||||
if (_needed > (available)) { \
|
||||
int allocated = 2 * _needed; \
|
||||
if (needed > (available)) { \
|
||||
int allocated = 2 * needed; \
|
||||
Tcl_Token *oldPtr = (tokenPtr); \
|
||||
Tcl_Token *newPtr; \
|
||||
if (oldPtr == (staticPtr)) { \
|
||||
@@ -4462,7 +4357,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr, \
|
||||
(unsigned int) (allocated * sizeof(Tcl_Token))); \
|
||||
if (newPtr == NULL) { \
|
||||
allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \
|
||||
allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH; \
|
||||
if (allocated > TCL_MAX_TOKENS) { \
|
||||
allocated = TCL_MAX_TOKENS; \
|
||||
} \
|
||||
@@ -4496,8 +4391,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
*/
|
||||
|
||||
#define TclUtfToUniChar(str, chPtr) \
|
||||
((((unsigned char) *(str)) < 0x80) ? \
|
||||
((*(chPtr) = (unsigned char) *(str)), 1) \
|
||||
((((unsigned char) *(str)) < 0xC0) ? \
|
||||
((*(chPtr) = (Tcl_UniChar) *(str)), 1) \
|
||||
: Tcl_UtfToUniChar(str, chPtr))
|
||||
|
||||
/*
|
||||
@@ -4514,14 +4409,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
|
||||
#define TclNumUtfChars(numChars, bytes, numBytes) \
|
||||
do { \
|
||||
int _count, _i = (numBytes); \
|
||||
unsigned char *_str = (unsigned char *) (bytes); \
|
||||
while (_i && (*_str < 0xC0)) { _i--; _str++; } \
|
||||
_count = (numBytes) - _i; \
|
||||
if (_i) { \
|
||||
_count += Tcl_NumUtfChars((bytes) + _count, _i); \
|
||||
int count, i = (numBytes); \
|
||||
unsigned char *str = (unsigned char *) (bytes); \
|
||||
while (i && (*str < 0xC0)) { i--; str++; } \
|
||||
count = (numBytes) - i; \
|
||||
if (i) { \
|
||||
count += Tcl_NumUtfChars((bytes) + count, i); \
|
||||
} \
|
||||
(numChars) = _count; \
|
||||
(numChars) = count; \
|
||||
} while (0);
|
||||
|
||||
/*
|
||||
@@ -4561,7 +4456,7 @@ MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Macro used by the Tcl core to increment a namespace's export epoch
|
||||
* Macro used by the Tcl core to increment a namespace's export export epoch
|
||||
* counter. The ANSI C "prototype" for this macro is:
|
||||
*
|
||||
* MODULE_SCOPE void TclInvalidateNsCmdLookup(Namespace *nsPtr);
|
||||
@@ -4621,19 +4516,45 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
|
||||
* core. They should only be called on unshared objects. The ANSI C
|
||||
* "prototypes" for these macros are:
|
||||
*
|
||||
* MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
|
||||
* MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue);
|
||||
* MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue);
|
||||
* MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue);
|
||||
* MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
|
||||
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#define TclSetIntObj(objPtr, i) \
|
||||
#define TclSetLongObj(objPtr, i) \
|
||||
do { \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
TclFreeIntRep(objPtr); \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
|
||||
(objPtr)->internalRep.longValue = (long)(i); \
|
||||
(objPtr)->typePtr = &tclIntType; \
|
||||
} while (0)
|
||||
|
||||
#define TclSetIntObj(objPtr, l) \
|
||||
TclSetLongObj(objPtr, l)
|
||||
|
||||
/*
|
||||
* NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
|
||||
* programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1.
|
||||
* The only "boolean" Tcl_Obj's shall be those holding the cached boolean
|
||||
* value of strings like: "yes", "no", "true", "false", "on", "off".
|
||||
*/
|
||||
|
||||
#define TclSetBooleanObj(objPtr, b) \
|
||||
TclSetLongObj(objPtr, (b)!=0);
|
||||
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
#define TclSetWideIntObj(objPtr, w) \
|
||||
do { \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
TclFreeIntRep(objPtr); \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
|
||||
(objPtr)->typePtr = &tclWideIntType; \
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
#define TclSetDoubleObj(objPtr, d) \
|
||||
do { \
|
||||
TclInvalidateStringRep(objPtr); \
|
||||
@@ -4648,7 +4569,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
|
||||
* types, avoiding the corresponding function calls in time critical parts of
|
||||
* the core. The ANSI C "prototypes" for these macros are:
|
||||
*
|
||||
* MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
|
||||
* MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l);
|
||||
* MODULE_SCOPE void TclNewBooleanObj(Tcl_Obj *objPtr, int b);
|
||||
* MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
|
||||
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
|
||||
* MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len);
|
||||
* MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
|
||||
@@ -4657,17 +4580,24 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
|
||||
*/
|
||||
|
||||
#ifndef TCL_MEM_DEBUG
|
||||
#define TclNewIntObj(objPtr, i) \
|
||||
#define TclNewLongObj(objPtr, i) \
|
||||
do { \
|
||||
TclIncrObjsAllocated(); \
|
||||
TclAllocObjStorage(objPtr); \
|
||||
(objPtr)->refCount = 0; \
|
||||
(objPtr)->bytes = NULL; \
|
||||
(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
|
||||
(objPtr)->internalRep.longValue = (long)(i); \
|
||||
(objPtr)->typePtr = &tclIntType; \
|
||||
TCL_DTRACE_OBJ_CREATE(objPtr); \
|
||||
} while (0)
|
||||
|
||||
/*
|
||||
* NOTE: There is to be no such thing as a "pure" boolean.
|
||||
* See comment above TclSetBooleanObj macro above.
|
||||
*/
|
||||
#define TclNewBooleanObj(objPtr, b) \
|
||||
TclNewLongObj((objPtr), (b)!=0)
|
||||
|
||||
#define TclNewDoubleObj(objPtr, d) \
|
||||
do { \
|
||||
TclIncrObjsAllocated(); \
|
||||
@@ -4690,8 +4620,11 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
|
||||
} while (0)
|
||||
|
||||
#else /* TCL_MEM_DEBUG */
|
||||
#define TclNewIntObj(objPtr, w) \
|
||||
(objPtr) = Tcl_NewWideIntObj(w)
|
||||
#define TclNewLongObj(objPtr, l) \
|
||||
(objPtr) = Tcl_NewLongObj(l)
|
||||
|
||||
#define TclNewBooleanObj(objPtr, b) \
|
||||
(objPtr) = Tcl_NewBooleanObj(b)
|
||||
|
||||
#define TclNewDoubleObj(objPtr, d) \
|
||||
(objPtr) = Tcl_NewDoubleObj(d)
|
||||
@@ -4834,11 +4767,11 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
|
||||
#ifndef TCL_MEM_DEBUG
|
||||
#define TclSmallAllocEx(interp, nbytes, memPtr) \
|
||||
do { \
|
||||
Tcl_Obj *_objPtr; \
|
||||
Tcl_Obj *objPtr; \
|
||||
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
|
||||
TclIncrObjsAllocated(); \
|
||||
TclAllocObjStorageEx((interp), (_objPtr)); \
|
||||
memPtr = (ClientData) (_objPtr); \
|
||||
TclAllocObjStorageEx((interp), (objPtr)); \
|
||||
memPtr = (ClientData) (objPtr); \
|
||||
} while (0)
|
||||
|
||||
#define TclSmallFreeEx(interp, memPtr) \
|
||||
@@ -4850,19 +4783,19 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
|
||||
#else /* TCL_MEM_DEBUG */
|
||||
#define TclSmallAllocEx(interp, nbytes, memPtr) \
|
||||
do { \
|
||||
Tcl_Obj *_objPtr; \
|
||||
Tcl_Obj *objPtr; \
|
||||
TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj)); \
|
||||
TclNewObj(_objPtr); \
|
||||
memPtr = (ClientData) _objPtr; \
|
||||
TclNewObj(objPtr); \
|
||||
memPtr = (ClientData) objPtr; \
|
||||
} while (0)
|
||||
|
||||
#define TclSmallFreeEx(interp, memPtr) \
|
||||
do { \
|
||||
Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr; \
|
||||
_objPtr->bytes = NULL; \
|
||||
_objPtr->typePtr = NULL; \
|
||||
_objPtr->refCount = 1; \
|
||||
TclDecrRefCount(_objPtr); \
|
||||
Tcl_Obj *objPtr = (Tcl_Obj *) memPtr; \
|
||||
objPtr->bytes = NULL; \
|
||||
objPtr->typePtr = NULL; \
|
||||
objPtr->refCount = 1; \
|
||||
TclDecrRefCount(objPtr); \
|
||||
} while (0)
|
||||
#endif /* TCL_MEM_DEBUG */
|
||||
|
||||
@@ -4914,15 +4847,15 @@ typedef struct NRE_callback {
|
||||
|
||||
#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
|
||||
do { \
|
||||
NRE_callback *_callbackPtr; \
|
||||
TCLNR_ALLOC((interp), (_callbackPtr)); \
|
||||
_callbackPtr->procPtr = (postProcPtr); \
|
||||
_callbackPtr->data[0] = (ClientData)(data0); \
|
||||
_callbackPtr->data[1] = (ClientData)(data1); \
|
||||
_callbackPtr->data[2] = (ClientData)(data2); \
|
||||
_callbackPtr->data[3] = (ClientData)(data3); \
|
||||
_callbackPtr->nextPtr = TOP_CB(interp); \
|
||||
TOP_CB(interp) = _callbackPtr; \
|
||||
NRE_callback *callbackPtr; \
|
||||
TCLNR_ALLOC((interp), (callbackPtr)); \
|
||||
callbackPtr->procPtr = (postProcPtr); \
|
||||
callbackPtr->data[0] = (ClientData)(data0); \
|
||||
callbackPtr->data[1] = (ClientData)(data1); \
|
||||
callbackPtr->data[2] = (ClientData)(data2); \
|
||||
callbackPtr->data[3] = (ClientData)(data3); \
|
||||
callbackPtr->nextPtr = TOP_CB(interp); \
|
||||
TOP_CB(interp) = callbackPtr; \
|
||||
} while (0)
|
||||
|
||||
#if NRE_USE_SMALL_ALLOC
|
||||
|
||||
+157
-174
@@ -28,21 +28,21 @@
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
|
||||
/* Those macro's are especially for Itcl 3.4 compatibility */
|
||||
# define tclCreateNamespace tcl_CreateNamespace
|
||||
# define tclDeleteNamespace tcl_DeleteNamespace
|
||||
# define tclAppendExportList tcl_AppendExportList
|
||||
# define tclExport tcl_Export
|
||||
# define tclImport tcl_Import
|
||||
# define tclForgetImport tcl_ForgetImport
|
||||
# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
|
||||
# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
|
||||
# define tclFindNamespace tcl_FindNamespace
|
||||
# define tclFindCommand tcl_FindCommand
|
||||
# define tclGetCommandFromObj tcl_GetCommandFromObj
|
||||
# define tclGetCommandFullName tcl_GetCommandFullName
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
|
||||
#undef Tcl_CreateNamespace
|
||||
#undef Tcl_DeleteNamespace
|
||||
#undef Tcl_AppendExportList
|
||||
#undef Tcl_Export
|
||||
#undef Tcl_Import
|
||||
#undef Tcl_ForgetImport
|
||||
#undef Tcl_GetCurrentNamespace
|
||||
#undef Tcl_GetGlobalNamespace
|
||||
#undef Tcl_FindNamespace
|
||||
#undef Tcl_FindCommand
|
||||
#undef Tcl_GetCommandFromObj
|
||||
#undef Tcl_GetCommandFullName
|
||||
#undef Tcl_SetStartupScript
|
||||
#undef Tcl_GetStartupScript
|
||||
|
||||
/*
|
||||
* WARNING: This file is automatically generated by the tools/genStubs.tcl
|
||||
@@ -75,8 +75,7 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
|
||||
EXTERN int TclCopyAndCollapse(int count, const char *src,
|
||||
char *dst);
|
||||
/* 8 */
|
||||
TCL_DEPRECATED("")
|
||||
int TclCopyChannelOld(Tcl_Interp *interp,
|
||||
EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
|
||||
Tcl_Channel inChan, Tcl_Channel outChan,
|
||||
int toRead, Tcl_Obj *cmdPtr);
|
||||
/* 9 */
|
||||
@@ -114,7 +113,7 @@ EXTERN int TclFindElement(Tcl_Interp *interp,
|
||||
/* 23 */
|
||||
EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName);
|
||||
/* 24 */
|
||||
EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n);
|
||||
EXTERN int TclFormatInt(char *buffer, long n);
|
||||
/* 25 */
|
||||
EXTERN void TclFreePackageInfo(Interp *iPtr);
|
||||
/* Slot 26 is reserved */
|
||||
@@ -174,7 +173,7 @@ EXTERN int TclInterpInit(Tcl_Interp *interp);
|
||||
/* 53 */
|
||||
EXTERN int TclInvokeObjectCommand(ClientData clientData,
|
||||
Tcl_Interp *interp, int argc,
|
||||
const char **argv);
|
||||
CONST84 char **argv);
|
||||
/* 54 */
|
||||
EXTERN int TclInvokeStringCommand(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
@@ -219,8 +218,7 @@ EXTERN unsigned long TclpGetClicks(void);
|
||||
/* 76 */
|
||||
EXTERN unsigned long TclpGetSeconds(void);
|
||||
/* 77 */
|
||||
TCL_DEPRECATED("")
|
||||
void TclpGetTime(Tcl_Time *time);
|
||||
EXTERN void TclpGetTime(Tcl_Time *time);
|
||||
/* Slot 78 is reserved */
|
||||
/* Slot 79 is reserved */
|
||||
/* Slot 80 is reserved */
|
||||
@@ -233,8 +231,7 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size);
|
||||
/* Slot 86 is reserved */
|
||||
/* Slot 87 is reserved */
|
||||
/* 88 */
|
||||
TCL_DEPRECATED("")
|
||||
char * TclPrecTraceProc(ClientData clientData,
|
||||
EXTERN char * TclPrecTraceProc(ClientData clientData,
|
||||
Tcl_Interp *interp, const char *name1,
|
||||
const char *name2, int flags);
|
||||
/* 89 */
|
||||
@@ -270,8 +267,7 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp);
|
||||
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
|
||||
const char *proto, int *portPtr);
|
||||
/* 104 */
|
||||
TCL_DEPRECATED("")
|
||||
int TclSockMinimumBuffersOld(int sock, int size);
|
||||
EXTERN int TclSockMinimumBuffersOld(int sock, int size);
|
||||
/* Slot 105 is reserved */
|
||||
/* Slot 106 is reserved */
|
||||
/* Slot 107 is reserved */
|
||||
@@ -288,22 +284,22 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
|
||||
Tcl_ResolveVarProc *varProc,
|
||||
Tcl_ResolveCompiledVarProc *compiledVarProc);
|
||||
/* 112 */
|
||||
EXTERN int TclAppendExportList(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_AppendExportList(Tcl_Interp *interp,
|
||||
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
|
||||
/* 113 */
|
||||
EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp,
|
||||
EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
|
||||
const char *name, ClientData clientData,
|
||||
Tcl_NamespaceDeleteProc *deleteProc);
|
||||
/* 114 */
|
||||
EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr);
|
||||
EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
|
||||
/* 115 */
|
||||
EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int resetListFirst);
|
||||
/* 116 */
|
||||
EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
|
||||
EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags);
|
||||
/* 117 */
|
||||
EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp,
|
||||
EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags);
|
||||
/* 118 */
|
||||
@@ -318,23 +314,23 @@ EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags);
|
||||
/* 121 */
|
||||
EXTERN int TclForgetImport(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_ForgetImport(Tcl_Interp *interp,
|
||||
Tcl_Namespace *nsPtr, const char *pattern);
|
||||
/* 122 */
|
||||
EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp,
|
||||
EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
/* 123 */
|
||||
EXTERN void TclGetCommandFullName(Tcl_Interp *interp,
|
||||
EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
|
||||
Tcl_Command command, Tcl_Obj *objPtr);
|
||||
/* 124 */
|
||||
EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp);
|
||||
EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
|
||||
/* 125 */
|
||||
EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp);
|
||||
EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
|
||||
/* 126 */
|
||||
EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp,
|
||||
Tcl_Var variable, Tcl_Obj *objPtr);
|
||||
/* 127 */
|
||||
EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int allowOverwrite);
|
||||
/* 128 */
|
||||
EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
|
||||
@@ -354,18 +350,19 @@ EXTERN void Tcl_SetNamespaceResolvers(
|
||||
/* 132 */
|
||||
EXTERN int TclpHasSockets(Tcl_Interp *interp);
|
||||
/* 133 */
|
||||
TCL_DEPRECATED("")
|
||||
struct tm * TclpGetDate(const time_t *time, int useGMT);
|
||||
EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
|
||||
/* Slot 134 is reserved */
|
||||
/* Slot 135 is reserved */
|
||||
/* Slot 136 is reserved */
|
||||
/* Slot 137 is reserved */
|
||||
/* 138 */
|
||||
EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr);
|
||||
EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
|
||||
Tcl_DString *valuePtr);
|
||||
/* Slot 139 is reserved */
|
||||
/* Slot 140 is reserved */
|
||||
/* 141 */
|
||||
EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
|
||||
EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
|
||||
Tcl_DString *cwdPtr);
|
||||
/* 142 */
|
||||
EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, CompileHookProc *hookProc,
|
||||
@@ -404,11 +401,9 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
|
||||
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
|
||||
const char *varName);
|
||||
/* 158 */
|
||||
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
|
||||
void TclSetStartupScriptFileName(const char *filename);
|
||||
EXTERN void TclSetStartupScriptFileName(const char *filename);
|
||||
/* 159 */
|
||||
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
|
||||
const char * TclGetStartupScriptFileName(void);
|
||||
EXTERN const char * TclGetStartupScriptFileName(void);
|
||||
/* Slot 160 is reserved */
|
||||
/* 161 */
|
||||
EXTERN int TclChannelTransform(Tcl_Interp *interp,
|
||||
@@ -427,11 +422,9 @@ EXTERN int TclListObjSetElement(Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr, int index,
|
||||
Tcl_Obj *valuePtr);
|
||||
/* 167 */
|
||||
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
|
||||
void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
|
||||
EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
|
||||
/* 168 */
|
||||
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
|
||||
Tcl_Obj * TclGetStartupScriptPath(void);
|
||||
EXTERN Tcl_Obj * TclGetStartupScriptPath(void);
|
||||
/* 169 */
|
||||
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
|
||||
unsigned long n);
|
||||
@@ -464,18 +457,16 @@ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, const char *operation,
|
||||
const char *reason);
|
||||
/* 178 */
|
||||
EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr,
|
||||
EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr,
|
||||
const char *encodingName);
|
||||
/* 179 */
|
||||
EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr);
|
||||
EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
|
||||
/* Slot 180 is reserved */
|
||||
/* Slot 181 is reserved */
|
||||
/* 182 */
|
||||
TCL_DEPRECATED("")
|
||||
struct tm * TclpLocaltime(const time_t *clock);
|
||||
EXTERN struct tm * TclpLocaltime(const time_t *clock);
|
||||
/* 183 */
|
||||
TCL_DEPRECATED("")
|
||||
struct tm * TclpGmtime(const time_t *clock);
|
||||
EXTERN struct tm * TclpGmtime(const time_t *clock);
|
||||
/* Slot 184 is reserved */
|
||||
/* Slot 185 is reserved */
|
||||
/* Slot 186 is reserved */
|
||||
@@ -579,8 +570,7 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
|
||||
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
|
||||
Namespace *nsPtr);
|
||||
/* 236 */
|
||||
TCL_DEPRECATED("use Tcl_BackgroundException")
|
||||
void TclBackgroundException(Tcl_Interp *interp, int code);
|
||||
EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
|
||||
/* 237 */
|
||||
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
|
||||
/* 238 */
|
||||
@@ -627,28 +617,6 @@ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
|
||||
/* 251 */
|
||||
EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes,
|
||||
int length, int flags);
|
||||
/* 252 */
|
||||
EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, const int flags);
|
||||
/* 253 */
|
||||
EXTERN Tcl_Obj * TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
|
||||
const int flags);
|
||||
/* 254 */
|
||||
EXTERN Tcl_Obj * TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
|
||||
const int flags);
|
||||
/* 255 */
|
||||
EXTERN int TclPtrObjMakeUpvar(Tcl_Interp *interp,
|
||||
Tcl_Var otherPtr, Tcl_Obj *myNamePtr,
|
||||
int myFlags);
|
||||
/* 256 */
|
||||
EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
|
||||
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
|
||||
Tcl_Obj *part2Ptr, const int flags);
|
||||
|
||||
typedef struct TclIntStubs {
|
||||
int magic;
|
||||
@@ -662,7 +630,7 @@ typedef struct TclIntStubs {
|
||||
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
|
||||
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
|
||||
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
|
||||
TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
|
||||
int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
|
||||
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
|
||||
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
|
||||
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
|
||||
@@ -678,7 +646,7 @@ typedef struct TclIntStubs {
|
||||
void (*reserved21)(void);
|
||||
int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
|
||||
Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
|
||||
int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
|
||||
int (*tclFormatInt) (char *buffer, long n); /* 24 */
|
||||
void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
|
||||
void (*reserved26)(void);
|
||||
void (*reserved27)(void);
|
||||
@@ -707,7 +675,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
|
||||
int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
|
||||
void (*reserved52)(void);
|
||||
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
|
||||
int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
|
||||
int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
|
||||
Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
|
||||
void (*reserved56)(void);
|
||||
@@ -731,7 +699,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclpFree) (char *ptr); /* 74 */
|
||||
unsigned long (*tclpGetClicks) (void); /* 75 */
|
||||
unsigned long (*tclpGetSeconds) (void); /* 76 */
|
||||
TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
|
||||
void (*tclpGetTime) (Tcl_Time *time); /* 77 */
|
||||
void (*reserved78)(void);
|
||||
void (*reserved79)(void);
|
||||
void (*reserved80)(void);
|
||||
@@ -742,7 +710,7 @@ typedef struct TclIntStubs {
|
||||
void (*reserved85)(void);
|
||||
void (*reserved86)(void);
|
||||
void (*reserved87)(void);
|
||||
TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
|
||||
char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
|
||||
int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
|
||||
void (*reserved90)(void);
|
||||
void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
|
||||
@@ -758,7 +726,7 @@ typedef struct TclIntStubs {
|
||||
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
|
||||
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
|
||||
TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
|
||||
int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
|
||||
void (*reserved105)(void);
|
||||
void (*reserved106)(void);
|
||||
void (*reserved107)(void);
|
||||
@@ -766,36 +734,36 @@ typedef struct TclIntStubs {
|
||||
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
|
||||
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
|
||||
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
|
||||
int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
|
||||
Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
|
||||
void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
|
||||
int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
|
||||
Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
|
||||
Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
|
||||
int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
|
||||
Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
|
||||
void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
|
||||
int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
|
||||
Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
|
||||
Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
|
||||
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
|
||||
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
|
||||
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
|
||||
int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
|
||||
Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
|
||||
void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
|
||||
Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
|
||||
Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
|
||||
int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
|
||||
Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
|
||||
void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
|
||||
Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
|
||||
Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
|
||||
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
|
||||
int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
|
||||
int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
|
||||
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
|
||||
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
|
||||
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
|
||||
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
|
||||
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
|
||||
TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
|
||||
struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
|
||||
void (*reserved134)(void);
|
||||
void (*reserved135)(void);
|
||||
void (*reserved136)(void);
|
||||
void (*reserved137)(void);
|
||||
const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
|
||||
CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
|
||||
void (*reserved139)(void);
|
||||
void (*reserved140)(void);
|
||||
const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
|
||||
CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
|
||||
int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
|
||||
int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
|
||||
void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
|
||||
@@ -812,8 +780,8 @@ typedef struct TclIntStubs {
|
||||
void (*reserved155)(void);
|
||||
void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
|
||||
Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
|
||||
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
|
||||
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
|
||||
void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
|
||||
const char * (*tclGetStartupScriptFileName) (void); /* 159 */
|
||||
void (*reserved160)(void);
|
||||
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
|
||||
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
|
||||
@@ -821,8 +789,8 @@ typedef struct TclIntStubs {
|
||||
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
|
||||
void (*tclpSetInitialEncodings) (void); /* 165 */
|
||||
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
|
||||
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
|
||||
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
|
||||
void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
|
||||
Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
|
||||
int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
|
||||
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
|
||||
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
|
||||
@@ -832,12 +800,12 @@ typedef struct TclIntStubs {
|
||||
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
|
||||
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
|
||||
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
|
||||
void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
|
||||
Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
|
||||
void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
|
||||
Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
|
||||
void (*reserved180)(void);
|
||||
void (*reserved181)(void);
|
||||
TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
|
||||
TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
|
||||
struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
|
||||
struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
|
||||
void (*reserved184)(void);
|
||||
void (*reserved185)(void);
|
||||
void (*reserved186)(void);
|
||||
@@ -890,7 +858,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
|
||||
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
|
||||
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
|
||||
TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
|
||||
void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
|
||||
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
|
||||
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
|
||||
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
|
||||
@@ -906,11 +874,6 @@ typedef struct TclIntStubs {
|
||||
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
|
||||
void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
|
||||
int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
|
||||
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
|
||||
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
|
||||
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
|
||||
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
|
||||
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
|
||||
} TclIntStubs;
|
||||
|
||||
extern const TclIntStubs *tclIntStubsPtr;
|
||||
@@ -1098,38 +1061,38 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
|
||||
#define Tcl_AddInterpResolvers \
|
||||
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
|
||||
#define TclAppendExportList \
|
||||
(tclIntStubsPtr->tclAppendExportList) /* 112 */
|
||||
#define TclCreateNamespace \
|
||||
(tclIntStubsPtr->tclCreateNamespace) /* 113 */
|
||||
#define TclDeleteNamespace \
|
||||
(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
|
||||
#define TclExport \
|
||||
(tclIntStubsPtr->tclExport) /* 115 */
|
||||
#define TclFindCommand \
|
||||
(tclIntStubsPtr->tclFindCommand) /* 116 */
|
||||
#define TclFindNamespace \
|
||||
(tclIntStubsPtr->tclFindNamespace) /* 117 */
|
||||
#define Tcl_AppendExportList \
|
||||
(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
|
||||
#define Tcl_CreateNamespace \
|
||||
(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
|
||||
#define Tcl_DeleteNamespace \
|
||||
(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
|
||||
#define Tcl_Export \
|
||||
(tclIntStubsPtr->tcl_Export) /* 115 */
|
||||
#define Tcl_FindCommand \
|
||||
(tclIntStubsPtr->tcl_FindCommand) /* 116 */
|
||||
#define Tcl_FindNamespace \
|
||||
(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
|
||||
#define Tcl_GetInterpResolvers \
|
||||
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
|
||||
#define Tcl_GetNamespaceResolvers \
|
||||
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
|
||||
#define Tcl_FindNamespaceVar \
|
||||
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
|
||||
#define TclForgetImport \
|
||||
(tclIntStubsPtr->tclForgetImport) /* 121 */
|
||||
#define TclGetCommandFromObj \
|
||||
(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
|
||||
#define TclGetCommandFullName \
|
||||
(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
|
||||
#define TclGetCurrentNamespace_ \
|
||||
(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
|
||||
#define TclGetGlobalNamespace_ \
|
||||
(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
|
||||
#define Tcl_ForgetImport \
|
||||
(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
|
||||
#define Tcl_GetCommandFromObj \
|
||||
(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
|
||||
#define Tcl_GetCommandFullName \
|
||||
(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
|
||||
#define Tcl_GetCurrentNamespace \
|
||||
(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
|
||||
#define Tcl_GetGlobalNamespace \
|
||||
(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
|
||||
#define Tcl_GetVariableFullName \
|
||||
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
|
||||
#define TclImport \
|
||||
(tclIntStubsPtr->tclImport) /* 127 */
|
||||
#define Tcl_Import \
|
||||
(tclIntStubsPtr->tcl_Import) /* 127 */
|
||||
#define Tcl_PopCallFrame \
|
||||
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
|
||||
#define Tcl_PushCallFrame \
|
||||
@@ -1220,10 +1183,10 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclCleanupVar) /* 176 */
|
||||
#define TclVarErrMsg \
|
||||
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
|
||||
#define TclSetStartupScript \
|
||||
(tclIntStubsPtr->tclSetStartupScript) /* 178 */
|
||||
#define TclGetStartupScript \
|
||||
(tclIntStubsPtr->tclGetStartupScript) /* 179 */
|
||||
#define Tcl_SetStartupScript \
|
||||
(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
|
||||
#define Tcl_GetStartupScript \
|
||||
(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
|
||||
/* Slot 180 is reserved */
|
||||
/* Slot 181 is reserved */
|
||||
#define TclpLocaltime \
|
||||
@@ -1342,16 +1305,6 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */
|
||||
#define TclRegisterLiteral \
|
||||
(tclIntStubsPtr->tclRegisterLiteral) /* 251 */
|
||||
#define TclPtrGetVar \
|
||||
(tclIntStubsPtr->tclPtrGetVar) /* 252 */
|
||||
#define TclPtrSetVar \
|
||||
(tclIntStubsPtr->tclPtrSetVar) /* 253 */
|
||||
#define TclPtrIncrObjVar \
|
||||
(tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */
|
||||
#define TclPtrObjMakeUpvar \
|
||||
(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
|
||||
#define TclPtrUnsetVar \
|
||||
(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
@@ -1360,28 +1313,58 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
|
||||
#if defined(USE_TCL_STUBS)
|
||||
# undef TclGetStartupScriptFileName
|
||||
# undef TclSetStartupScriptFileName
|
||||
# undef TclGetStartupScriptPath
|
||||
# undef TclSetStartupScriptPath
|
||||
# undef TclBackgroundException
|
||||
# undef TclSetStartupScript
|
||||
# undef TclGetStartupScript
|
||||
# undef TclCreateNamespace
|
||||
# undef TclDeleteNamespace
|
||||
# undef TclAppendExportList
|
||||
# undef TclExport
|
||||
# undef TclImport
|
||||
# undef TclForgetImport
|
||||
# undef TclGetCurrentNamespace_
|
||||
# undef TclGetGlobalNamespace_
|
||||
# undef TclFindNamespace
|
||||
# undef TclFindCommand
|
||||
# undef TclGetCommandFromObj
|
||||
# undef TclGetCommandFullName
|
||||
# undef TclCopyChannelOld
|
||||
# undef TclSockMinimumBuffersOld
|
||||
#undef TclGetStartupScriptFileName
|
||||
#undef TclSetStartupScriptFileName
|
||||
#undef TclGetStartupScriptPath
|
||||
#undef TclSetStartupScriptPath
|
||||
#undef TclBackgroundException
|
||||
|
||||
#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
|
||||
# undef Tcl_SetStartupScript
|
||||
# define Tcl_SetStartupScript \
|
||||
(tclStubsPtr->tcl_SetStartupScript) /* 622 */
|
||||
# undef Tcl_GetStartupScript
|
||||
# define Tcl_GetStartupScript \
|
||||
(tclStubsPtr->tcl_GetStartupScript) /* 623 */
|
||||
# undef Tcl_CreateNamespace
|
||||
# define Tcl_CreateNamespace \
|
||||
(tclStubsPtr->tcl_CreateNamespace) /* 506 */
|
||||
# undef Tcl_DeleteNamespace
|
||||
# define Tcl_DeleteNamespace \
|
||||
(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
|
||||
# undef Tcl_AppendExportList
|
||||
# define Tcl_AppendExportList \
|
||||
(tclStubsPtr->tcl_AppendExportList) /* 508 */
|
||||
# undef Tcl_Export
|
||||
# define Tcl_Export \
|
||||
(tclStubsPtr->tcl_Export) /* 509 */
|
||||
# undef Tcl_Import
|
||||
# define Tcl_Import \
|
||||
(tclStubsPtr->tcl_Import) /* 510 */
|
||||
# undef Tcl_ForgetImport
|
||||
# define Tcl_ForgetImport \
|
||||
(tclStubsPtr->tcl_ForgetImport) /* 511 */
|
||||
# undef Tcl_GetCurrentNamespace
|
||||
# define Tcl_GetCurrentNamespace \
|
||||
(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
|
||||
# undef Tcl_GetGlobalNamespace
|
||||
# define Tcl_GetGlobalNamespace \
|
||||
(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
|
||||
# undef Tcl_FindNamespace
|
||||
# define Tcl_FindNamespace \
|
||||
(tclStubsPtr->tcl_FindNamespace) /* 514 */
|
||||
# undef Tcl_FindCommand
|
||||
# define Tcl_FindCommand \
|
||||
(tclStubsPtr->tcl_FindCommand) /* 515 */
|
||||
# undef Tcl_GetCommandFromObj
|
||||
# define Tcl_GetCommandFromObj \
|
||||
(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
|
||||
# undef Tcl_GetCommandFullName
|
||||
# define Tcl_GetCommandFullName \
|
||||
(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
|
||||
#endif
|
||||
|
||||
#undef TclCopyChannelOld
|
||||
#undef TclSockMinimumBuffersOld
|
||||
|
||||
#endif /* _TCLINTDECLS */
|
||||
|
||||
@@ -555,18 +555,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
# undef TclWinGetServByName
|
||||
# undef TclWinGetSockOpt
|
||||
# undef TclWinSetSockOpt
|
||||
# undef TclWinGetPlatformId
|
||||
# undef TclWinResetInterfaces
|
||||
# undef TclWinSetInterfaces
|
||||
# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define TclWinNToHS ntohs
|
||||
# define TclWinGetServByName getservbyname
|
||||
# define TclWinGetSockOpt getsockopt
|
||||
# define TclWinSetSockOpt setsockopt
|
||||
# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
|
||||
# define TclWinResetInterfaces() /* nop */
|
||||
# define TclWinSetInterfaces(dummy) /* nop */
|
||||
# endif /* TCL_NO_DEPRECATED */
|
||||
# define TclWinNToHS ntohs
|
||||
# define TclWinGetServByName getservbyname
|
||||
# define TclWinGetSockOpt getsockopt
|
||||
# define TclWinSetSockOpt setsockopt
|
||||
#else
|
||||
# undef TclpGetPid
|
||||
# define TclpGetPid(pid) ((unsigned long) (pid))
|
||||
|
||||
@@ -3208,6 +3208,10 @@ Tcl_MakeSafe(
|
||||
|
||||
(void) Tcl_EvalEx(interp,
|
||||
"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
|
||||
(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
|
||||
"::tcl::mathfunc::min", 0, NULL);
|
||||
(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
|
||||
"::tcl::mathfunc::max", 0, NULL);
|
||||
}
|
||||
|
||||
iPtr->flags |= SAFE_INTERP;
|
||||
@@ -3529,6 +3533,9 @@ Tcl_LimitAddHandler(
|
||||
if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
|
||||
deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
|
||||
}
|
||||
if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) {
|
||||
deleteProc = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Allocate a handler record.
|
||||
|
||||
+105
-98
@@ -36,10 +36,8 @@ typedef struct Link {
|
||||
unsigned int ui;
|
||||
short s;
|
||||
unsigned short us;
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
|
||||
long l;
|
||||
unsigned long ul;
|
||||
#endif
|
||||
Tcl_WideInt w;
|
||||
Tcl_WideUInt uw;
|
||||
float f;
|
||||
@@ -70,7 +68,6 @@ static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
|
||||
const char *name1, const char *name2, int flags);
|
||||
static Tcl_Obj * ObjValue(Link *linkPtr);
|
||||
static int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
|
||||
static int GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
|
||||
static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
|
||||
|
||||
/*
|
||||
@@ -131,14 +128,6 @@ Tcl_LinkVar(
|
||||
Tcl_IncrRefCount(linkPtr->varName);
|
||||
linkPtr->addr = addr;
|
||||
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
|
||||
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
|
||||
|| defined(_WIN32) || defined(__CYGWIN__))
|
||||
if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
|
||||
linkPtr->type = TCL_LINK_LONG;
|
||||
} else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
|
||||
linkPtr->type = TCL_LINK_ULONG;
|
||||
}
|
||||
#endif
|
||||
if (type & TCL_LINK_READ_ONLY) {
|
||||
linkPtr->flags = LINK_READ_ONLY;
|
||||
} else {
|
||||
@@ -345,14 +334,12 @@ LinkTraceProc(
|
||||
case TCL_LINK_UINT:
|
||||
changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
|
||||
break;
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
|
||||
case TCL_LINK_LONG:
|
||||
changed = (LinkedVar(long) != linkPtr->lastValue.l);
|
||||
break;
|
||||
case TCL_LINK_ULONG:
|
||||
changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
|
||||
break;
|
||||
#endif
|
||||
case TCL_LINK_FLOAT:
|
||||
changed = (LinkedVar(float) != linkPtr->lastValue.f);
|
||||
break;
|
||||
@@ -394,31 +381,38 @@ LinkTraceProc(
|
||||
|
||||
switch (linkPtr->type) {
|
||||
case TCL_LINK_INT:
|
||||
if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK
|
||||
&& GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
|
||||
!= TCL_OK) {
|
||||
if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have integer value";
|
||||
return (char *) "variable must have integer value";
|
||||
}
|
||||
}
|
||||
LinkedVar(int) = linkPtr->lastValue.i;
|
||||
break;
|
||||
|
||||
case TCL_LINK_WIDE_INT:
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK
|
||||
&& GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
|
||||
!= TCL_OK) {
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have integer value";
|
||||
return (char *) "variable must have integer value";
|
||||
}
|
||||
linkPtr->lastValue.w = (Tcl_WideInt) valueInt;
|
||||
}
|
||||
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
|
||||
break;
|
||||
|
||||
case TCL_LINK_DOUBLE:
|
||||
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
|
||||
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
|
||||
!= TCL_OK) {
|
||||
#ifdef ACCEPT_NAN
|
||||
if (valueObj->typePtr != &tclDoubleType) {
|
||||
#endif
|
||||
if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
|
||||
if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d)
|
||||
!= TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have real value";
|
||||
@@ -432,7 +426,8 @@ LinkTraceProc(
|
||||
break;
|
||||
|
||||
case TCL_LINK_BOOLEAN:
|
||||
if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
|
||||
if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
|
||||
!= TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have boolean value";
|
||||
@@ -441,106 +436,131 @@ LinkTraceProc(
|
||||
break;
|
||||
|
||||
case TCL_LINK_CHAR:
|
||||
if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|
||||
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have char value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have char value";
|
||||
}
|
||||
}
|
||||
LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;
|
||||
linkPtr->lastValue.c = (char)valueInt;
|
||||
LinkedVar(char) = linkPtr->lastValue.c;
|
||||
break;
|
||||
|
||||
case TCL_LINK_UCHAR:
|
||||
if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|
||||
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
|| valueInt < 0 || valueInt > UCHAR_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned char value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned char value";
|
||||
}
|
||||
}
|
||||
LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;
|
||||
linkPtr->lastValue.uc = (unsigned char) valueInt;
|
||||
LinkedVar(unsigned char) = linkPtr->lastValue.uc;
|
||||
break;
|
||||
|
||||
case TCL_LINK_SHORT:
|
||||
if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|
||||
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have short value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have short value";
|
||||
}
|
||||
}
|
||||
LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;
|
||||
linkPtr->lastValue.s = (short)valueInt;
|
||||
LinkedVar(short) = linkPtr->lastValue.s;
|
||||
break;
|
||||
|
||||
case TCL_LINK_USHORT:
|
||||
if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
&& GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|
||||
if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
|
||||
|| valueInt < 0 || valueInt > USHRT_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned short value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned short value";
|
||||
}
|
||||
}
|
||||
LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;
|
||||
linkPtr->lastValue.us = (unsigned short)valueInt;
|
||||
LinkedVar(unsigned short) = linkPtr->lastValue.us;
|
||||
break;
|
||||
|
||||
case TCL_LINK_UINT:
|
||||
if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
|| valueWide < 0 || valueWide > UINT_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned int value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned int value";
|
||||
}
|
||||
linkPtr->lastValue.ui = (unsigned int)valueInt;
|
||||
} else {
|
||||
linkPtr->lastValue.ui = (unsigned int)valueWide;
|
||||
}
|
||||
LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
|
||||
LinkedVar(unsigned int) = linkPtr->lastValue.ui;
|
||||
break;
|
||||
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
|
||||
case TCL_LINK_LONG:
|
||||
if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have long value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have long value";
|
||||
}
|
||||
linkPtr->lastValue.l = (long)valueInt;
|
||||
} else {
|
||||
linkPtr->lastValue.l = (long)valueWide;
|
||||
}
|
||||
LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;
|
||||
LinkedVar(long) = linkPtr->lastValue.l;
|
||||
break;
|
||||
|
||||
case TCL_LINK_ULONG:
|
||||
if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned long value";
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned long value";
|
||||
}
|
||||
linkPtr->lastValue.ul = (unsigned long)valueInt;
|
||||
} else {
|
||||
linkPtr->lastValue.ul = (unsigned long)valueWide;
|
||||
}
|
||||
LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
|
||||
LinkedVar(unsigned long) = linkPtr->lastValue.ul;
|
||||
break;
|
||||
#endif
|
||||
|
||||
case TCL_LINK_WIDE_UINT:
|
||||
/*
|
||||
* FIXME: represent as a bignum.
|
||||
*/
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
|
||||
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned wide int value";
|
||||
if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
|
||||
if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have unsigned wide int value";
|
||||
}
|
||||
linkPtr->lastValue.uw = (Tcl_WideUInt)valueInt;
|
||||
} else {
|
||||
linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
|
||||
}
|
||||
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
|
||||
LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
|
||||
break;
|
||||
|
||||
case TCL_LINK_FLOAT:
|
||||
if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
|
||||
&& GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK)
|
||||
if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
|
||||
|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have float value";
|
||||
if (GetInvalidDoubleFromObj(valueObj, &valueDouble)
|
||||
!= TCL_OK) {
|
||||
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
|
||||
TCL_GLOBAL_ONLY);
|
||||
return (char *) "variable must have float value";
|
||||
}
|
||||
}
|
||||
LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble;
|
||||
linkPtr->lastValue.f = (float)valueDouble;
|
||||
LinkedVar(float) = linkPtr->lastValue.f;
|
||||
break;
|
||||
|
||||
case TCL_LINK_STRING:
|
||||
@@ -611,14 +631,12 @@ ObjValue(
|
||||
case TCL_LINK_UINT:
|
||||
linkPtr->lastValue.ui = LinkedVar(unsigned int);
|
||||
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
|
||||
case TCL_LINK_LONG:
|
||||
linkPtr->lastValue.l = LinkedVar(long);
|
||||
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
|
||||
case TCL_LINK_ULONG:
|
||||
linkPtr->lastValue.ul = LinkedVar(unsigned long);
|
||||
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
|
||||
#endif
|
||||
case TCL_LINK_FLOAT:
|
||||
linkPtr->lastValue.f = LinkedVar(float);
|
||||
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
|
||||
@@ -654,7 +672,7 @@ static Tcl_ObjType invalidRealType = {
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL /* setFromAnyProc */
|
||||
SetInvalidRealFromAny /* setFromAnyProc */
|
||||
};
|
||||
|
||||
static int
|
||||
@@ -692,7 +710,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
|
||||
/*
|
||||
* This function checks for integer representations, which are valid
|
||||
* when linking with C variables, but which are invalid in other
|
||||
* contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
|
||||
* contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
|
||||
* (upperand lowercase). See bug [39f6304c2e].
|
||||
*/
|
||||
int
|
||||
@@ -701,7 +719,7 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
|
||||
const char *str = TclGetString(objPtr);
|
||||
|
||||
if ((objPtr->length == 0) ||
|
||||
((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
|
||||
((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
|
||||
*intPtr = 0;
|
||||
return TCL_OK;
|
||||
} else if ((objPtr->length == 1) && strchr("+-", str[0])) {
|
||||
@@ -711,18 +729,6 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
int
|
||||
GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
|
||||
{
|
||||
int intValue;
|
||||
|
||||
if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*widePtr = intValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* This function checks for double representations, which are valid
|
||||
* when linking with C variables, but which are invalid in other
|
||||
@@ -730,7 +736,8 @@ GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
|
||||
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
|
||||
*/
|
||||
int
|
||||
GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr)
|
||||
GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
|
||||
double *doublePtr)
|
||||
{
|
||||
int intValue;
|
||||
|
||||
|
||||
+24
-94
@@ -407,6 +407,7 @@ TclListObjCopy(
|
||||
* to be returned. */
|
||||
{
|
||||
Tcl_Obj *copyPtr;
|
||||
int length;
|
||||
|
||||
if (listPtr->typePtr != &tclListType) {
|
||||
if (SetListFromAny(interp, listPtr) != TCL_OK) {
|
||||
@@ -415,92 +416,14 @@ TclListObjCopy(
|
||||
}
|
||||
|
||||
TclNewObj(copyPtr);
|
||||
TclInvalidateStringRep(copyPtr);
|
||||
DupListInternalRep(listPtr, copyPtr);
|
||||
TclListObjLength(NULL, listPtr, &length);
|
||||
if (length > 0) {
|
||||
TclInvalidateStringRep(copyPtr);
|
||||
DupListInternalRep(listPtr, copyPtr);
|
||||
}
|
||||
return copyPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclListObjRange --
|
||||
*
|
||||
* Makes a slice of a list value.
|
||||
* *listPtr must be known to be a valid list.
|
||||
*
|
||||
* Results:
|
||||
* Returns a pointer to the sliced list.
|
||||
* This may be a new object or the same object if not shared.
|
||||
*
|
||||
* Side effects:
|
||||
* The possible conversion of the object referenced by listPtr
|
||||
* to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
TclListObjRange(
|
||||
Tcl_Obj *listPtr, /* List object to take a range from. */
|
||||
int fromIdx, /* Index of first element to include. */
|
||||
int toIdx) /* Index of last element to include. */
|
||||
{
|
||||
Tcl_Obj **elemPtrs;
|
||||
int listLen, i, newLen;
|
||||
List *listRepPtr;
|
||||
|
||||
TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
|
||||
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
if (toIdx >= listLen) {
|
||||
toIdx = listLen-1;
|
||||
}
|
||||
if (fromIdx > toIdx) {
|
||||
return Tcl_NewObj();
|
||||
}
|
||||
|
||||
newLen = toIdx - fromIdx + 1;
|
||||
|
||||
if (Tcl_IsShared(listPtr) ||
|
||||
((ListRepPtr(listPtr)->refCount > 1))) {
|
||||
return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
|
||||
}
|
||||
|
||||
/*
|
||||
* In-place is possible.
|
||||
*/
|
||||
|
||||
/*
|
||||
* Even if nothing below cause any changes, we still want the
|
||||
* string-canonizing effect of [lrange 0 end].
|
||||
*/
|
||||
|
||||
TclInvalidateStringRep(listPtr);
|
||||
|
||||
/*
|
||||
* Delete elements that should not be included.
|
||||
*/
|
||||
|
||||
for (i = 0; i < fromIdx; i++) {
|
||||
TclDecrRefCount(elemPtrs[i]);
|
||||
}
|
||||
for (i = toIdx + 1; i < listLen; i++) {
|
||||
TclDecrRefCount(elemPtrs[i]);
|
||||
}
|
||||
|
||||
if (fromIdx > 0) {
|
||||
memmove(elemPtrs, &elemPtrs[fromIdx],
|
||||
(size_t) newLen * sizeof(Tcl_Obj*));
|
||||
}
|
||||
|
||||
listRepPtr = ListRepPtr(listPtr);
|
||||
listRepPtr->elemCount = newLen;
|
||||
|
||||
return listPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -546,15 +469,15 @@ Tcl_ListObjGetElements(
|
||||
if (listPtr->typePtr != &tclListType) {
|
||||
int result;
|
||||
|
||||
result = SetListFromAny(interp, listPtr);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
if (listPtr->bytes == &tclEmptyString) {
|
||||
*objcPtr = 0;
|
||||
*objvPtr = NULL;
|
||||
return TCL_OK;
|
||||
}
|
||||
result = SetListFromAny(interp, listPtr);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
}
|
||||
listRepPtr = ListRepPtr(listPtr);
|
||||
*objcPtr = listRepPtr->elemCount;
|
||||
@@ -1246,11 +1169,17 @@ TclLindexList(
|
||||
return TclLindexFlat(interp, listPtr, 1, &argPtr);
|
||||
}
|
||||
|
||||
{
|
||||
int indexCount = -1; /* Size of the array of list indices. */
|
||||
Tcl_Obj **indices = NULL; /* Array of list indices. */
|
||||
if (indexListCopy->typePtr == &tclListType) {
|
||||
List *listRepPtr = ListRepPtr(indexListCopy);
|
||||
|
||||
TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
|
||||
listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
|
||||
&listRepPtr->elements);
|
||||
} else {
|
||||
int indexCount = -1; /* Size of the array of list indices. */
|
||||
Tcl_Obj **indices = NULL;
|
||||
/* Array of list indices. */
|
||||
|
||||
Tcl_ListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
|
||||
listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
|
||||
}
|
||||
Tcl_DecrRefCount(indexListCopy);
|
||||
@@ -1946,6 +1875,7 @@ SetListFromAny(
|
||||
int estCount, length;
|
||||
const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);
|
||||
|
||||
if (length == 0) return TCL_OK;
|
||||
/*
|
||||
* Allocate enough space to hold a (Tcl_Obj *) for each
|
||||
* (possible) list element.
|
||||
@@ -2032,8 +1962,8 @@ static void
|
||||
UpdateStringOfList(
|
||||
Tcl_Obj *listPtr) /* List object with string rep to update. */
|
||||
{
|
||||
# define LOCAL_SIZE 64
|
||||
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
# define LOCAL_SIZE 20
|
||||
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
List *listRepPtr = ListRepPtr(listPtr);
|
||||
int numElems = listRepPtr->elemCount;
|
||||
int i, length, bytesNeeded = 0;
|
||||
@@ -2070,7 +2000,7 @@ UpdateStringOfList(
|
||||
* We know numElems <= LIST_MAX, so this is safe.
|
||||
*/
|
||||
|
||||
flagPtr = ckalloc(numElems);
|
||||
flagPtr = ckalloc(numElems * sizeof(int));
|
||||
}
|
||||
elemPtrs = &listRepPtr->elements;
|
||||
for (i = 0; i < numElems; i++) {
|
||||
|
||||
+11
-12
@@ -186,7 +186,7 @@ TclCreateLiteral(
|
||||
{
|
||||
LiteralTable *globalTablePtr = &iPtr->literalTable;
|
||||
LiteralEntry *globalPtr;
|
||||
unsigned int globalHash;
|
||||
int globalHash;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
/*
|
||||
@@ -393,8 +393,7 @@ TclRegisterLiteral(
|
||||
LiteralEntry *globalPtr, *localPtr;
|
||||
Tcl_Obj *objPtr;
|
||||
unsigned hash;
|
||||
unsigned int localHash;
|
||||
int objIndex, new;
|
||||
int localHash, objIndex, new;
|
||||
Namespace *nsPtr;
|
||||
|
||||
if (length < 0) {
|
||||
@@ -538,8 +537,7 @@ TclHideLiteral(
|
||||
{
|
||||
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
|
||||
LiteralTable *localTablePtr = &envPtr->localLitTable;
|
||||
unsigned int localHash;
|
||||
int length;
|
||||
int localHash, length;
|
||||
const char *bytes;
|
||||
Tcl_Obj *newObjPtr;
|
||||
|
||||
@@ -558,7 +556,7 @@ TclHideLiteral(
|
||||
lPtr->objPtr = newObjPtr;
|
||||
|
||||
bytes = TclGetStringFromObj(newObjPtr, &length);
|
||||
localHash = HashString(bytes, length) & localTablePtr->mask;
|
||||
localHash = (HashString(bytes, length) & localTablePtr->mask);
|
||||
nextPtrPtr = &localTablePtr->buckets[localHash];
|
||||
|
||||
for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
|
||||
@@ -614,7 +612,7 @@ TclAddLiteralObj(
|
||||
lPtr = &envPtr->literalArrayPtr[objIndex];
|
||||
lPtr->objPtr = objPtr;
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
lPtr->refCount = (size_t)-1; /* i.e., unused */
|
||||
lPtr->refCount = -1; /* i.e., unused */
|
||||
lPtr->nextPtr = NULL;
|
||||
|
||||
if (litPtrPtr) {
|
||||
@@ -811,8 +809,7 @@ TclReleaseLiteral(
|
||||
LiteralTable *globalTablePtr;
|
||||
register LiteralEntry *entryPtr, *prevPtr;
|
||||
const char *bytes;
|
||||
int length;
|
||||
unsigned int index;
|
||||
int length, index;
|
||||
|
||||
if (iPtr == NULL) {
|
||||
goto done;
|
||||
@@ -831,13 +828,15 @@ TclReleaseLiteral(
|
||||
for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
|
||||
entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
|
||||
if (entryPtr->objPtr == objPtr) {
|
||||
entryPtr->refCount--;
|
||||
|
||||
/*
|
||||
* If the literal is no longer being used by any ByteCode, delete
|
||||
* the entry then remove the reference corresponding to the global
|
||||
* literal table entry (decrement the ref count of the object).
|
||||
*/
|
||||
|
||||
if (entryPtr->refCount-- <= 1) {
|
||||
if (entryPtr->refCount == 0) {
|
||||
if (prevPtr == NULL) {
|
||||
globalTablePtr->buckets[index] = entryPtr->nextPtr;
|
||||
} else {
|
||||
@@ -955,8 +954,8 @@ RebuildLiteralTable(
|
||||
register LiteralEntry *entryPtr;
|
||||
LiteralEntry **bucketPtr;
|
||||
const char *bytes;
|
||||
unsigned int oldSize, index;
|
||||
int count, length;
|
||||
unsigned int oldSize;
|
||||
int count, index, length;
|
||||
|
||||
oldSize = tablePtr->numBuckets;
|
||||
oldBuckets = tablePtr->buckets;
|
||||
|
||||
+2
-15
@@ -130,7 +130,7 @@ Tcl_LoadObjCmd(
|
||||
Tcl_PackageInitProc *initProc;
|
||||
const char *p, *fullFileName, *packageName;
|
||||
Tcl_LoadHandle loadHandle;
|
||||
Tcl_UniChar ch = 0;
|
||||
Tcl_UniChar ch;
|
||||
unsigned len;
|
||||
int index, flags = 0;
|
||||
Tcl_Obj *const *savedobjv = objv;
|
||||
@@ -336,7 +336,7 @@ Tcl_LoadObjCmd(
|
||||
}
|
||||
#endif /* __CYGWIN__ */
|
||||
for (p = pkgGuess; *p != 0; p += offset) {
|
||||
offset = TclUtfToUniChar(p, &ch);
|
||||
offset = Tcl_UtfToUniChar(p, &ch);
|
||||
if ((ch > 0x100)
|
||||
|| !(isalpha(UCHAR(ch)) /* INTL: ISO only */
|
||||
|| (UCHAR(ch) == '_'))) {
|
||||
@@ -470,19 +470,6 @@ Tcl_LoadObjCmd(
|
||||
*/
|
||||
|
||||
if (code != TCL_OK) {
|
||||
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
|
||||
Interp *iPtr = (Interp *) target;
|
||||
if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) {
|
||||
/*
|
||||
* A call to Tcl_InitStubs() determined the caller extension and
|
||||
* this interp are incompatible in their stubs mechanisms, and
|
||||
* recorded the error in the oldest legacy place we have to do so.
|
||||
*/
|
||||
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1));
|
||||
iPtr->result = &tclEmptyString;
|
||||
iPtr->freeProc = NULL;
|
||||
}
|
||||
#endif /* defined(TCL_NO_DEPRECATED) */
|
||||
Tcl_TransferResult(target, code, interp);
|
||||
goto done;
|
||||
}
|
||||
|
||||
+5
-1
@@ -266,14 +266,18 @@ Tcl_SourceRCFile(
|
||||
|
||||
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
|
||||
if (c != NULL) {
|
||||
Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1);
|
||||
|
||||
Tcl_Close(NULL, c);
|
||||
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
|
||||
Tcl_IncrRefCount(fullNameObj);
|
||||
if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) {
|
||||
chan = Tcl_GetStdChannel(TCL_STDERR);
|
||||
if (chan) {
|
||||
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
|
||||
Tcl_WriteChars(chan, "\n", 1);
|
||||
}
|
||||
}
|
||||
Tcl_DecrRefCount(fullNameObj);
|
||||
}
|
||||
}
|
||||
Tcl_DStringFree(&temp);
|
||||
|
||||
+14
-40
@@ -31,8 +31,8 @@
|
||||
* limited to a single interpreter.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
unsigned long numNsCreated; /* Count of the number of namespaces created
|
||||
typedef struct ThreadSpecificData {
|
||||
size_t numNsCreated; /* Count of the number of namespaces created
|
||||
* within the thread. This value is used as a
|
||||
* unique id for each namespace. Cannot be
|
||||
* per-interp because the nsId is used to
|
||||
@@ -402,7 +402,7 @@ Tcl_PopCallFrame(
|
||||
}
|
||||
if (framePtr->numCompiledLocals > 0) {
|
||||
TclDeleteCompiledLocalVars(iPtr, framePtr);
|
||||
if (framePtr->localCachePtr->refCount-- <= 1) {
|
||||
if (--framePtr->localCachePtr->refCount == 0) {
|
||||
TclFreeLocalCache(interp, framePtr->localCachePtr);
|
||||
}
|
||||
framePtr->localCachePtr = NULL;
|
||||
@@ -915,11 +915,6 @@ Tcl_DeleteNamespace(
|
||||
Tcl_HashSearch search;
|
||||
Command *cmdPtr;
|
||||
|
||||
/*
|
||||
* Ensure that this namespace doesn't get deallocated in the meantime.
|
||||
*/
|
||||
nsPtr->refCount++;
|
||||
|
||||
/*
|
||||
* Give anyone interested - notably TclOO - a chance to use this namespace
|
||||
* normally despite the fact that the namespace is going to go. Allows the
|
||||
@@ -1052,7 +1047,16 @@ Tcl_DeleteNamespace(
|
||||
#endif
|
||||
Tcl_DeleteHashTable(&nsPtr->cmdTable);
|
||||
|
||||
nsPtr ->flags |= NS_DEAD;
|
||||
/*
|
||||
* If the reference count is 0, then discard the namespace.
|
||||
* Otherwise, mark it as "dead" so that it can't be used.
|
||||
*/
|
||||
|
||||
if (nsPtr->refCount == 0) {
|
||||
NamespaceFree(nsPtr);
|
||||
} else {
|
||||
nsPtr->flags |= NS_DEAD;
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Restore the ::errorInfo and ::errorCode traces.
|
||||
@@ -1069,7 +1073,6 @@ Tcl_DeleteNamespace(
|
||||
nsPtr->flags &= ~(NS_DYING|NS_KILLED);
|
||||
}
|
||||
}
|
||||
TclNsDecrRefCount(nsPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2418,35 +2421,6 @@ TclGetNamespaceForQualName(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclEnsureNamespace --
|
||||
*
|
||||
* Provide a namespace that is not deleted.
|
||||
*
|
||||
* Value
|
||||
*
|
||||
* namespacePtr, if it is not scheduled for deletion, or a pointer to a
|
||||
* new namespace with the same name otherwise.
|
||||
*
|
||||
* Effect
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
Tcl_Namespace *
|
||||
TclEnsureNamespace(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Namespace *namespacePtr)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *) namespacePtr;
|
||||
if (!(nsPtr->flags & NS_DYING)) {
|
||||
return namespacePtr;
|
||||
}
|
||||
return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2664,7 +2638,7 @@ Tcl_FindCommand(
|
||||
Namespace *nsPtr[2];
|
||||
register int search;
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, cxtNsPtr,
|
||||
TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
|
||||
flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
|
||||
|
||||
/*
|
||||
|
||||
+592
-579
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -24,7 +24,7 @@
|
||||
* win/tclooConfig.sh
|
||||
*/
|
||||
|
||||
#define TCLOO_VERSION "1.2.0"
|
||||
#define TCLOO_VERSION "1.0.4"
|
||||
#define TCLOO_PATCHLEVEL TCLOO_VERSION
|
||||
|
||||
#include "tcl.h"
|
||||
|
||||
+15
-24
@@ -1183,9 +1183,8 @@ TclOOCopyObjectCmd(
|
||||
{
|
||||
Tcl_Object oPtr, o2Ptr;
|
||||
|
||||
if (objc < 2 || objc > 4) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"sourceName ?targetName? ?targetNamespace?");
|
||||
if (objc < 2 || objc > 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "sourceName ?targetName?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1205,32 +1204,24 @@ TclOOCopyObjectCmd(
|
||||
if (objc == 2) {
|
||||
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
|
||||
} else {
|
||||
const char *name, *namespaceName;
|
||||
const char *name;
|
||||
Tcl_DString buffer;
|
||||
|
||||
name = TclGetString(objv[2]);
|
||||
if (name[0] == '\0') {
|
||||
name = NULL;
|
||||
}
|
||||
Tcl_DStringInit(&buffer);
|
||||
if (name[0]!=':' || name[1]!=':') {
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Choose a unique namespace name if the user didn't supply one.
|
||||
*/
|
||||
|
||||
namespaceName = NULL;
|
||||
if (objc == 4) {
|
||||
namespaceName = TclGetString(objv[3]);
|
||||
|
||||
if (namespaceName[0] == '\0') {
|
||||
namespaceName = NULL;
|
||||
} else if (Tcl_FindNamespace(interp, namespaceName, NULL,
|
||||
0) != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"%s refers to an existing namespace", namespaceName));
|
||||
return TCL_ERROR;
|
||||
if (iPtr->varFramePtr != NULL) {
|
||||
Tcl_DStringAppend(&buffer,
|
||||
iPtr->varFramePtr->nsPtr->fullName, -1);
|
||||
}
|
||||
TclDStringAppendLiteral(&buffer, "::");
|
||||
Tcl_DStringAppend(&buffer, name, -1);
|
||||
name = Tcl_DStringValue(&buffer);
|
||||
}
|
||||
|
||||
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
|
||||
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, NULL);
|
||||
Tcl_DStringFree(&buffer);
|
||||
}
|
||||
|
||||
if (o2Ptr == NULL) {
|
||||
|
||||
+24
-73
@@ -53,8 +53,7 @@ static void AddClassFiltersToCallContext(Object *const oPtr,
|
||||
Class *clsPtr, struct ChainBuilder *const cbPtr,
|
||||
Tcl_HashTable *const doneFilters, int flags);
|
||||
static void AddClassMethodNames(Class *clsPtr, const int flags,
|
||||
Tcl_HashTable *const namesPtr,
|
||||
Tcl_HashTable *const examinedClassesPtr);
|
||||
Tcl_HashTable *const namesPtr);
|
||||
static inline void AddMethodToCallChain(Method *const mPtr,
|
||||
struct ChainBuilder *const cbPtr,
|
||||
Tcl_HashTable *const doneFilters,
|
||||
@@ -110,12 +109,7 @@ TclOODeleteContext(
|
||||
TclOODeleteChain(contextPtr->callPtr);
|
||||
if (oPtr != NULL) {
|
||||
TclStackFree(oPtr->fPtr->interp, contextPtr);
|
||||
|
||||
/*
|
||||
* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
|
||||
*/
|
||||
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -238,7 +232,7 @@ FreeMethodNameRep(
|
||||
* TclOOInvokeContext --
|
||||
*
|
||||
* Invokes a single step along a method call-chain context. Note that the
|
||||
* invocation of a step along the chain can cause further steps along the
|
||||
* invokation of a step along the chain can cause further steps along the
|
||||
* chain to be invoked. Note that this function is written to be as light
|
||||
* in stack usage as possible.
|
||||
*
|
||||
@@ -373,10 +367,6 @@ TclOOGetSortedMethodList(
|
||||
{
|
||||
Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
|
||||
* mapping. */
|
||||
Tcl_HashTable examinedClasses;
|
||||
/* Used to track what classes have been looked
|
||||
* at. Is set-like in nature and keyed by
|
||||
* pointer to class. */
|
||||
FOREACH_HASH_DECLS;
|
||||
int i;
|
||||
Class *mixinPtr;
|
||||
@@ -386,7 +376,6 @@ TclOOGetSortedMethodList(
|
||||
void *isWanted;
|
||||
|
||||
Tcl_InitObjHashTable(&names);
|
||||
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
|
||||
|
||||
/*
|
||||
* Name the bits used in the names table values.
|
||||
@@ -447,14 +436,11 @@ TclOOGetSortedMethodList(
|
||||
* hierarchy.
|
||||
*/
|
||||
|
||||
AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
|
||||
AddClassMethodNames(oPtr->selfCls, flags, &names);
|
||||
FOREACH(mixinPtr, oPtr->mixins) {
|
||||
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
|
||||
&examinedClasses);
|
||||
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names);
|
||||
}
|
||||
|
||||
Tcl_DeleteHashTable(&examinedClasses);
|
||||
|
||||
/*
|
||||
* See how many (visible) method names there are. If none, we do not (and
|
||||
* should not) try to sort the list of them.
|
||||
@@ -509,24 +495,18 @@ TclOOGetSortedClassMethodList(
|
||||
{
|
||||
Tcl_HashTable names; /* Tcl_Obj* method name to "wanted in list"
|
||||
* mapping. */
|
||||
Tcl_HashTable examinedClasses;
|
||||
/* Used to track what classes have been looked
|
||||
* at. Is set-like in nature and keyed by
|
||||
* pointer to class. */
|
||||
FOREACH_HASH_DECLS;
|
||||
int i;
|
||||
Tcl_Obj *namePtr;
|
||||
void *isWanted;
|
||||
|
||||
Tcl_InitObjHashTable(&names);
|
||||
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
|
||||
|
||||
/*
|
||||
* Process method names from the class hierarchy and the mixin hierarchy.
|
||||
*/
|
||||
|
||||
AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
|
||||
Tcl_DeleteHashTable(&examinedClasses);
|
||||
AddClassMethodNames(clsPtr, flags, &names);
|
||||
|
||||
/*
|
||||
* See how many (visible) method names there are. If none, we do not (and
|
||||
@@ -601,28 +581,14 @@ AddClassMethodNames(
|
||||
Class *clsPtr, /* Class to get method names from. */
|
||||
const int flags, /* Whether we are interested in just the
|
||||
* public method names. */
|
||||
Tcl_HashTable *const namesPtr,
|
||||
Tcl_HashTable *const namesPtr)
|
||||
/* Reference to the hash table to put the
|
||||
* information in. The hash table maps the
|
||||
* Tcl_Obj * method name to an integral value
|
||||
* describing whether the method is wanted.
|
||||
* This ensures that public/private override
|
||||
* semantics are handled correctly. */
|
||||
Tcl_HashTable *const examinedClassesPtr)
|
||||
/* Hash table that tracks what classes have
|
||||
* already been looked at. The keys are the
|
||||
* pointers to the classes, and the values are
|
||||
* immaterial. */
|
||||
* semantics are handled correctly.*/
|
||||
{
|
||||
/*
|
||||
* If we've already started looking at this class, stop working on it now
|
||||
* to prevent repeated work.
|
||||
*/
|
||||
|
||||
if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
|
||||
return;
|
||||
}
|
||||
|
||||
/*
|
||||
* Scope all declarations so that the compiler can stand a good chance of
|
||||
* making the recursive step highly efficient. We also hand-implement the
|
||||
@@ -630,37 +596,29 @@ AddClassMethodNames(
|
||||
* tail-recursion optimization usefully.
|
||||
*/
|
||||
|
||||
if (clsPtr->mixins.num != 0) {
|
||||
Class *mixinPtr;
|
||||
int i;
|
||||
|
||||
/* TODO: Beware of infinite loops! */
|
||||
FOREACH(mixinPtr, clsPtr->mixins) {
|
||||
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, namesPtr);
|
||||
}
|
||||
}
|
||||
|
||||
while (1) {
|
||||
FOREACH_HASH_DECLS;
|
||||
Tcl_Obj *namePtr;
|
||||
Method *mPtr;
|
||||
int isNew;
|
||||
|
||||
(void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
|
||||
&isNew);
|
||||
if (!isNew) {
|
||||
break;
|
||||
}
|
||||
|
||||
if (clsPtr->mixins.num != 0) {
|
||||
Class *mixinPtr;
|
||||
int i;
|
||||
|
||||
FOREACH(mixinPtr, clsPtr->mixins) {
|
||||
if (mixinPtr != clsPtr) {
|
||||
AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
|
||||
namesPtr, examinedClassesPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
|
||||
int isNew;
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
|
||||
if (isNew) {
|
||||
int isWanted = (!(flags & PUBLIC_METHOD)
|
||||
|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
|
||||
|
||||
isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
|
||||
Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
|
||||
} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
|
||||
&& mPtr->typePtr != NULL) {
|
||||
@@ -681,8 +639,7 @@ AddClassMethodNames(
|
||||
int i;
|
||||
|
||||
FOREACH(superPtr, clsPtr->superclasses) {
|
||||
AddClassMethodNames(superPtr, flags, namesPtr,
|
||||
examinedClassesPtr);
|
||||
AddClassMethodNames(superPtr, flags, namesPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -835,7 +792,7 @@ AddMethodToCallChain(
|
||||
* Call chain semantics states that methods come as *late* in the
|
||||
* call chain as possible. This is done by copying down the
|
||||
* following methods. Note that this does not change the number of
|
||||
* method invocations in the call chain; it just rearranges them.
|
||||
* method invokations in the call chain; it just rearranges them.
|
||||
*/
|
||||
|
||||
Class *declCls = callPtr->chain[i].filterDeclarer;
|
||||
@@ -905,7 +862,6 @@ InitCallChain(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* IsStillValid --
|
||||
*
|
||||
* Calculates whether the given call chain can be used for executing a
|
||||
* method for the given object. The condition on a chain from a cached
|
||||
* location being reusable is:
|
||||
@@ -941,7 +897,7 @@ IsStillValid(
|
||||
* TclOOGetCallContext --
|
||||
*
|
||||
* Responsible for constructing the call context, an ordered list of all
|
||||
* method implementations to be called as part of a method invocation.
|
||||
* method implementations to be called as part of a method invokation.
|
||||
* This method is central to the whole operation of the OO system.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -1177,11 +1133,6 @@ TclOOGetCallContext(
|
||||
returnContext:
|
||||
contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
|
||||
contextPtr->oPtr = oPtr;
|
||||
|
||||
/*
|
||||
* Corresponding TclOODecrRefCount() in TclOODeleteContext
|
||||
*/
|
||||
|
||||
AddRef(oPtr);
|
||||
contextPtr->callPtr = callPtr;
|
||||
contextPtr->skip = 2;
|
||||
@@ -1528,7 +1479,7 @@ TclOORenderCallChain(
|
||||
/*
|
||||
* Do the actual construction of the descriptions. They consist of a list
|
||||
* of triples that describe the details of how a method is understood. For
|
||||
* each triple, the first word is the type of invocation ("method" is
|
||||
* each triple, the first word is the type of invokation ("method" is
|
||||
* normal, "unknown" is special because it adds the method name as an
|
||||
* extra argument when handled by some method types, and "filter" is
|
||||
* special because it's a filter method). The second word is the name of
|
||||
|
||||
+158
-184
@@ -47,11 +47,8 @@ struct DeclaredSlot {
|
||||
static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
|
||||
static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
|
||||
Tcl_Namespace *const namespacePtr);
|
||||
static inline void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
|
||||
static void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
|
||||
Tcl_Obj *savedNameObj, const char *typeOfSubject);
|
||||
static inline int MagicDefinitionInvoke(Tcl_Interp *interp,
|
||||
Tcl_Namespace *nsPtr, int cmdIndex,
|
||||
int objc, Tcl_Obj *const *objv);
|
||||
static inline Class * GetClassInOuterContext(Tcl_Interp *interp,
|
||||
Tcl_Obj *className, const char *errMsg);
|
||||
static inline int InitDefineContext(Tcl_Interp *interp,
|
||||
@@ -123,7 +120,6 @@ static const struct DeclaredSlot slots[] = {
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* BumpGlobalEpoch --
|
||||
*
|
||||
* Utility that ensures that call chains that are invalid will get thrown
|
||||
* away at an appropriate time. Note that exactly which epoch gets
|
||||
* advanced will depend on exactly what the class is tangled up in; in
|
||||
@@ -168,7 +164,6 @@ BumpGlobalEpoch(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* RecomputeClassCacheFlag --
|
||||
*
|
||||
* Determine whether the object is prototypical of its class, and hence
|
||||
* able to use the class's method chain cache.
|
||||
*
|
||||
@@ -191,7 +186,6 @@ RecomputeClassCacheFlag(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOObjectSetFilters --
|
||||
*
|
||||
* Install a list of filter method names into an object.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -250,7 +244,6 @@ TclOOObjectSetFilters(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOClassSetFilters --
|
||||
*
|
||||
* Install a list of filter method names into a class.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -313,7 +306,6 @@ TclOOClassSetFilters(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOObjectSetMixins --
|
||||
*
|
||||
* Install a list of mixin classes into an object.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -331,8 +323,9 @@ TclOOObjectSetMixins(
|
||||
if (numMixins == 0) {
|
||||
if (oPtr->mixins.num != 0) {
|
||||
FOREACH(mixinPtr, oPtr->mixins) {
|
||||
TclOORemoveFromInstances(oPtr, mixinPtr);
|
||||
TclOODecrRefCount(mixinPtr->thisPtr);
|
||||
if (mixinPtr) {
|
||||
TclOORemoveFromInstances(oPtr, mixinPtr);
|
||||
}
|
||||
}
|
||||
ckfree(oPtr->mixins.list);
|
||||
oPtr->mixins.num = 0;
|
||||
@@ -344,7 +337,6 @@ TclOOObjectSetMixins(
|
||||
if (mixinPtr && mixinPtr != oPtr->selfCls) {
|
||||
TclOORemoveFromInstances(oPtr, mixinPtr);
|
||||
}
|
||||
TclOODecrRefCount(mixinPtr->thisPtr);
|
||||
}
|
||||
oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
|
||||
sizeof(Class *) * numMixins);
|
||||
@@ -357,8 +349,6 @@ TclOOObjectSetMixins(
|
||||
FOREACH(mixinPtr, oPtr->mixins) {
|
||||
if (mixinPtr != oPtr->selfCls) {
|
||||
TclOOAddToInstances(oPtr, mixinPtr);
|
||||
/* For the new copy created by memcpy */
|
||||
AddRef(mixinPtr->thisPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -369,7 +359,6 @@ TclOOObjectSetMixins(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOClassSetMixins --
|
||||
*
|
||||
* Install a list of mixin classes into a class.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -389,7 +378,6 @@ TclOOClassSetMixins(
|
||||
if (classPtr->mixins.num != 0) {
|
||||
FOREACH(mixinPtr, classPtr->mixins) {
|
||||
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
|
||||
TclOODecrRefCount(mixinPtr->thisPtr);
|
||||
}
|
||||
ckfree(classPtr->mixins.list);
|
||||
classPtr->mixins.num = 0;
|
||||
@@ -398,7 +386,6 @@ TclOOClassSetMixins(
|
||||
if (classPtr->mixins.num != 0) {
|
||||
FOREACH(mixinPtr, classPtr->mixins) {
|
||||
TclOORemoveFromMixinSubs(classPtr, mixinPtr);
|
||||
TclOODecrRefCount(mixinPtr->thisPtr);
|
||||
}
|
||||
classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
|
||||
sizeof(Class *) * numMixins);
|
||||
@@ -409,8 +396,6 @@ TclOOClassSetMixins(
|
||||
memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
|
||||
FOREACH(mixinPtr, classPtr->mixins) {
|
||||
TclOOAddToMixinSubs(classPtr, mixinPtr);
|
||||
/* For the new copy created by memcpy */
|
||||
AddRef(mixinPtr->thisPtr);
|
||||
}
|
||||
}
|
||||
BumpGlobalEpoch(interp, classPtr);
|
||||
@@ -420,7 +405,6 @@ TclOOClassSetMixins(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* RenameDeleteMethod --
|
||||
*
|
||||
* Core of the code to rename and delete methods.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -510,7 +494,6 @@ RenameDeleteMethod(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOUnknownDefinition --
|
||||
*
|
||||
* Handles what happens when an unknown command is encountered during the
|
||||
* processing of a definition script. Works by finding a command in the
|
||||
* operating definition namespace that the requested command is a unique
|
||||
@@ -589,7 +572,6 @@ TclOOUnknownDefinition(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* FindCommand --
|
||||
*
|
||||
* Specialized version of Tcl_FindCommand that handles command prefixes
|
||||
* and disallows namespace magic.
|
||||
*
|
||||
@@ -650,7 +632,6 @@ FindCommand(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* InitDefineContext --
|
||||
*
|
||||
* Does the magic incantations necessary to push the special stack frame
|
||||
* used when processing object definitions. It is up to the caller to
|
||||
* dispose of the frame (with TclPopStackFrame) when finished.
|
||||
@@ -676,9 +657,7 @@ InitDefineContext(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
|
||||
*/
|
||||
/* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
|
||||
|
||||
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
|
||||
namespacePtr, FRAME_IS_OO_DEFINE);
|
||||
@@ -693,7 +672,6 @@ InitDefineContext(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOGetDefineCmdContext --
|
||||
*
|
||||
* Extracts the magic token from the current stack frame, or returns NULL
|
||||
* (and leaves an error message) otherwise.
|
||||
*
|
||||
@@ -730,7 +708,6 @@ TclOOGetDefineCmdContext(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* GetClassInOuterContext --
|
||||
*
|
||||
* Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
|
||||
* context that called oo::define (or equivalent). Note that this may
|
||||
* have to go up multiple levels to get the level that we started doing
|
||||
@@ -773,13 +750,12 @@ GetClassInOuterContext(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* GenerateErrorInfo --
|
||||
*
|
||||
* Factored out code to generate part of the error trace messages.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline void
|
||||
static void
|
||||
GenerateErrorInfo(
|
||||
Tcl_Interp *interp, /* Where to store the error info trace. */
|
||||
Object *oPtr, /* What object (or class) was being configured
|
||||
@@ -808,75 +784,10 @@ GenerateErrorInfo(
|
||||
(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* MagicDefinitionInvoke --
|
||||
*
|
||||
* Part of the implementation of the "oo::define" and "oo::objdefine"
|
||||
* commands that is used to implement the more-than-one-argument case,
|
||||
* applying ensemble-like tricks with dispatch so that error messages are
|
||||
* clearer. Doesn't handle the management of the stack frame.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
MagicDefinitionInvoke(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Namespace *nsPtr,
|
||||
int cmdIndex,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Tcl_Command cmd;
|
||||
int isRoot, dummy, result, offset = cmdIndex + 1;
|
||||
|
||||
/*
|
||||
* More than one argument: fire them through the ensemble processing
|
||||
* engine so that everything appears to be good and proper in error
|
||||
* messages. Note that we cannot just concatenate and send through
|
||||
* Tcl_EvalObjEx, as that doesn't do ensemble processing, and we cannot go
|
||||
* through Tcl_EvalObjv without the extra work to pre-find the command, as
|
||||
* that finds command names in the wrong namespace at the moment. Ugly!
|
||||
*/
|
||||
|
||||
isRoot = TclInitRewriteEnsemble(interp, offset, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
* comments above for why these contortions are necessary.
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
obj2Ptr = Tcl_NewObj();
|
||||
cmd = FindCommand(interp, objv[cmdIndex], nsPtr);
|
||||
if (cmd == NULL) {
|
||||
/* punt this case! */
|
||||
Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
|
||||
} else {
|
||||
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
|
||||
/* TODO: overflow? */
|
||||
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-offset, objv+offset);
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-cmdIndex, objs, TCL_EVAL_INVOKE);
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineObjCmd --
|
||||
*
|
||||
* Implementation of the "oo::define" command. Works by effectively doing
|
||||
* the same as 'namespace eval', but with extra magic applied so that the
|
||||
* object to be modified is known to the commands in the target
|
||||
@@ -894,8 +805,8 @@ TclOODefineObjCmd(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
Object *oPtr;
|
||||
int result;
|
||||
Object *oPtr;
|
||||
|
||||
if (objc < 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
|
||||
@@ -935,9 +846,48 @@ TclOODefineObjCmd(
|
||||
}
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Tcl_Command cmd;
|
||||
int isRoot, dummy;
|
||||
|
||||
/*
|
||||
* More than one argument: fire them through the ensemble processing
|
||||
* engine so that everything appears to be good and proper in error
|
||||
* messages. Note that we cannot just concatenate and send through
|
||||
* Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
|
||||
* cannot go through Tcl_EvalObjv without the extra work to pre-find
|
||||
* the command, as that finds command names in the wrong namespace at
|
||||
* the moment. Ugly!
|
||||
*/
|
||||
|
||||
isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
* comments above for why these contortions are necessary.
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
obj2Ptr = Tcl_NewObj();
|
||||
cmd = FindCommand(interp, objv[2], fPtr->defineNs);
|
||||
if (cmd == NULL) {
|
||||
/* punt this case! */
|
||||
Tcl_AppendObjToObj(obj2Ptr, objv[2]);
|
||||
} else {
|
||||
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
|
||||
/* TODO: overflow? */
|
||||
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the previous "current" namespace.
|
||||
@@ -951,7 +901,6 @@ TclOODefineObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOOObjDefObjCmd --
|
||||
*
|
||||
* Implementation of the "oo::objdefine" command. Works by effectively
|
||||
* doing the same as 'namespace eval', but with extra magic applied so
|
||||
* that the object to be modified is known to the commands in the target
|
||||
@@ -969,8 +918,8 @@ TclOOObjDefObjCmd(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
int isRoot, result;
|
||||
Object *oPtr;
|
||||
int result;
|
||||
|
||||
if (objc < 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
|
||||
@@ -1003,9 +952,49 @@ TclOOObjDefObjCmd(
|
||||
}
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Tcl_Command cmd;
|
||||
int dummy;
|
||||
|
||||
/*
|
||||
* More than one argument: fire them through the ensemble processing
|
||||
* engine so that everything appears to be good and proper in error
|
||||
* messages. Note that we cannot just concatenate and send through
|
||||
* Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
|
||||
* cannot go through Tcl_EvalObjv without the extra work to pre-find
|
||||
* the command, as that finds command names in the wrong namespace at
|
||||
* the moment. Ugly!
|
||||
*/
|
||||
|
||||
isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
* comments above for why these contortions are necessary.
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
obj2Ptr = Tcl_NewObj();
|
||||
cmd = FindCommand(interp, objv[2], fPtr->objdefNs);
|
||||
if (cmd == NULL) {
|
||||
/* punt this case! */
|
||||
Tcl_AppendObjToObj(obj2Ptr, objv[2]);
|
||||
} else {
|
||||
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
|
||||
/* TODO: overflow? */
|
||||
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
|
||||
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the previous "current" namespace.
|
||||
@@ -1019,7 +1008,6 @@ TclOOObjDefObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineSelfObjCmd --
|
||||
*
|
||||
* Implementation of the "self" subcommand of the "oo::define" command.
|
||||
* Works by effectively doing the same as 'namespace eval', but with
|
||||
* extra magic applied so that the object to be modified is known to the
|
||||
@@ -1037,19 +1025,19 @@ TclOODefineSelfObjCmd(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
Object *oPtr;
|
||||
int result;
|
||||
Object *oPtr;
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Make the oo::objdefine namespace the current namespace and evaluate the
|
||||
* command(s).
|
||||
@@ -1071,9 +1059,48 @@ TclOODefineSelfObjCmd(
|
||||
}
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
|
||||
Tcl_Obj *objPtr, *obj2Ptr, **objs;
|
||||
Tcl_Command cmd;
|
||||
int isRoot, dummy;
|
||||
|
||||
/*
|
||||
* More than one argument: fire them through the ensemble processing
|
||||
* engine so that everything appears to be good and proper in error
|
||||
* messages. Note that we cannot just concatenate and send through
|
||||
* Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
|
||||
* cannot go through Tcl_EvalObjv without the extra work to pre-find
|
||||
* the command, as that finds command names in the wrong namespace at
|
||||
* the moment. Ugly!
|
||||
*/
|
||||
|
||||
isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv);
|
||||
|
||||
/*
|
||||
* Build the list of arguments using a Tcl_Obj as a workspace. See
|
||||
* comments above for why these contortions are necessary.
|
||||
*/
|
||||
|
||||
objPtr = Tcl_NewObj();
|
||||
obj2Ptr = Tcl_NewObj();
|
||||
cmd = FindCommand(interp, objv[1], fPtr->objdefNs);
|
||||
if (cmd == NULL) {
|
||||
/* punt this case! */
|
||||
Tcl_AppendObjToObj(obj2Ptr, objv[1]);
|
||||
} else {
|
||||
Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
|
||||
/* TODO: overflow? */
|
||||
Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-2, objv+2);
|
||||
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
|
||||
|
||||
result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
|
||||
if (isRoot) {
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
}
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the previous "current" namespace.
|
||||
@@ -1083,45 +1110,10 @@ TclOODefineSelfObjCmd(
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineObjSelfObjCmd --
|
||||
*
|
||||
* Implementation of the "self" subcommand of the "oo::objdefine"
|
||||
* command.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOODefineObjSelfObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr;
|
||||
|
||||
if (objc != 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineClassObjCmd --
|
||||
*
|
||||
* Implementation of the "class" subcommand of the "oo::objdefine"
|
||||
* command.
|
||||
*
|
||||
@@ -1137,6 +1129,7 @@ TclOODefineClassObjCmd(
|
||||
{
|
||||
Object *oPtr;
|
||||
Class *clsPtr;
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
|
||||
/*
|
||||
* Parse the context to get the object to operate on.
|
||||
@@ -1173,6 +1166,20 @@ TclOODefineClassObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Apply semantic checks. In particular, classes and non-classes are not
|
||||
* interchangable (too complicated to do the conversion!) so we must
|
||||
* produce an error if any attempt is made to swap from one to the other.
|
||||
*/
|
||||
|
||||
if ((oPtr->classPtr==NULL) == TclOOIsReachable(fPtr->classCls, clsPtr)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"may not change a %sclass object into a %sclass object",
|
||||
(oPtr->classPtr==NULL ? "non-" : ""),
|
||||
(oPtr->classPtr==NULL ? "" : "non-")));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "TRANSMUTATION", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Set the object's class.
|
||||
@@ -1180,11 +1187,11 @@ TclOODefineClassObjCmd(
|
||||
|
||||
if (oPtr->selfCls != clsPtr) {
|
||||
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
|
||||
TclOODecrRefCount(oPtr->selfCls->thisPtr);
|
||||
oPtr->selfCls = clsPtr;
|
||||
AddRef(oPtr->selfCls->thisPtr);
|
||||
TclOOAddToInstances(oPtr, oPtr->selfCls);
|
||||
|
||||
if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
|
||||
oPtr->flags &= ~CLASS_GONE;
|
||||
}
|
||||
if (oPtr->classPtr != NULL) {
|
||||
BumpGlobalEpoch(interp, oPtr->classPtr);
|
||||
} else {
|
||||
@@ -1198,7 +1205,6 @@ TclOODefineClassObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineConstructorObjCmd --
|
||||
*
|
||||
* Implementation of the "constructor" subcommand of the "oo::define"
|
||||
* command.
|
||||
*
|
||||
@@ -1267,7 +1273,6 @@ TclOODefineConstructorObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineDeleteMethodObjCmd --
|
||||
*
|
||||
* Implementation of the "deletemethod" subcommand of the "oo::define"
|
||||
* and "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1324,7 +1329,6 @@ TclOODefineDeleteMethodObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineDestructorObjCmd --
|
||||
*
|
||||
* Implementation of the "destructor" subcommand of the "oo::define"
|
||||
* command.
|
||||
*
|
||||
@@ -1389,7 +1393,6 @@ TclOODefineDestructorObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineExportObjCmd --
|
||||
*
|
||||
* Implementation of the "export" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1484,7 +1487,6 @@ TclOODefineExportObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineForwardObjCmd --
|
||||
*
|
||||
* Implementation of the "forward" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1545,7 +1547,6 @@ TclOODefineForwardObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineMethodObjCmd --
|
||||
*
|
||||
* Implementation of the "method" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1603,7 +1604,6 @@ TclOODefineMethodObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineMixinObjCmd --
|
||||
*
|
||||
* Implementation of the "mixin" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1667,7 +1667,6 @@ TclOODefineMixinObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineRenameMethodObjCmd --
|
||||
*
|
||||
* Implementation of the "renamemethod" subcommand of the "oo::define"
|
||||
* and "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1724,7 +1723,6 @@ TclOODefineRenameMethodObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineUnexportObjCmd --
|
||||
*
|
||||
* Implementation of the "unexport" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
@@ -1819,7 +1817,6 @@ TclOODefineUnexportObjCmd(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
|
||||
*
|
||||
* How to install a constructor or destructor into a class; API to call
|
||||
* from C.
|
||||
*
|
||||
@@ -1874,7 +1871,6 @@ Tcl_ClassSetDestructor(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineSlots --
|
||||
*
|
||||
* Create the "::oo::Slot" class and its standard instances. Class
|
||||
* definition is empty at the stage (added by scripting).
|
||||
*
|
||||
@@ -1918,7 +1914,6 @@ TclOODefineSlots(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ClassFilterGet, ClassFilterSet --
|
||||
*
|
||||
* Implementation of the "filter" slot accessors of the "oo::define"
|
||||
* command.
|
||||
*
|
||||
@@ -1998,7 +1993,6 @@ ClassFilterSet(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ClassMixinGet, ClassMixinSet --
|
||||
*
|
||||
* Implementation of the "mixin" slot accessors of the "oo::define"
|
||||
* command.
|
||||
*
|
||||
@@ -2080,7 +2074,6 @@ ClassMixinSet(
|
||||
mixins[i] = GetClassInOuterContext(interp, mixinv[i],
|
||||
"may only mix in classes");
|
||||
if (mixins[i] == NULL) {
|
||||
i--;
|
||||
goto freeAndError;
|
||||
}
|
||||
if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
|
||||
@@ -2104,7 +2097,6 @@ ClassMixinSet(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ClassSuperGet, ClassSuperSet --
|
||||
*
|
||||
* Implementation of the "superclass" slot accessors of the "oo::define"
|
||||
* command.
|
||||
*
|
||||
@@ -2199,19 +2191,16 @@ ClassSuperSet(
|
||||
|
||||
if (superc == 0) {
|
||||
superclasses = ckrealloc(superclasses, sizeof(Class *));
|
||||
superclasses[0] = oPtr->fPtr->objectCls;
|
||||
superc = 1;
|
||||
if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
|
||||
superclasses[0] = oPtr->fPtr->classCls;
|
||||
} else {
|
||||
superclasses[0] = oPtr->fPtr->objectCls;
|
||||
}
|
||||
superc = 1;
|
||||
AddRef(superclasses[0]->thisPtr);
|
||||
} else {
|
||||
for (i=0 ; i<superc ; i++) {
|
||||
superclasses[i] = GetClassInOuterContext(interp, superv[i],
|
||||
"only a class can be a superclass");
|
||||
if (superclasses[i] == NULL) {
|
||||
i--;
|
||||
goto failedAfterAlloc;
|
||||
}
|
||||
for (j=0 ; j<i ; j++) {
|
||||
@@ -2228,19 +2217,9 @@ ClassSuperSet(
|
||||
"attempt to form circular dependency graph", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
|
||||
failedAfterAlloc:
|
||||
for (; i > 0; i--) {
|
||||
TclOODecrRefCount(superclasses[i]->thisPtr);
|
||||
}
|
||||
ckfree(superclasses);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Corresponding TclOODecrRefCount() is near the end of this
|
||||
* function.
|
||||
*/
|
||||
|
||||
AddRef(superclasses[i]->thisPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2254,7 +2233,6 @@ ClassSuperSet(
|
||||
if (oPtr->classPtr->superclasses.num != 0) {
|
||||
FOREACH(superPtr, oPtr->classPtr->superclasses) {
|
||||
TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
|
||||
TclOODecrRefCount(superPtr->thisPtr);
|
||||
}
|
||||
ckfree(oPtr->classPtr->superclasses.list);
|
||||
}
|
||||
@@ -2272,7 +2250,6 @@ ClassSuperSet(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ClassVarsGet, ClassVarsSet --
|
||||
*
|
||||
* Implementation of the "variable" slot accessors of the "oo::define"
|
||||
* command.
|
||||
*
|
||||
@@ -2415,7 +2392,6 @@ ClassVarsSet(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ObjectFilterGet, ObjectFilterSet --
|
||||
*
|
||||
* Implementation of the "filter" slot accessors of the "oo::objdefine"
|
||||
* command.
|
||||
*
|
||||
@@ -2483,7 +2459,6 @@ ObjFilterSet(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ObjectMixinGet, ObjectMixinSet --
|
||||
*
|
||||
* Implementation of the "mixin" slot accessors of the "oo::objdefine"
|
||||
* command.
|
||||
*
|
||||
@@ -2569,7 +2544,6 @@ ObjMixinSet(
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* ObjectVarsGet, ObjectVarsSet --
|
||||
*
|
||||
* Implementation of the "variable" slot accessors of the "oo::objdefine"
|
||||
* command.
|
||||
*
|
||||
|
||||
+36
-33
@@ -149,8 +149,8 @@ typedef struct Object {
|
||||
struct Foundation *fPtr; /* The basis for the object system. Putting
|
||||
* this here allows the avoidance of quite a
|
||||
* lot of hash lookups on the critical path
|
||||
* for object invocation and creation. */
|
||||
Tcl_Namespace *namespacePtr;/* This object's namespace. */
|
||||
* for object invokation and creation. */
|
||||
Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
|
||||
Tcl_Command command; /* Reference to this object's public
|
||||
* command. */
|
||||
Tcl_Command myCommand; /* Reference to this object's internal
|
||||
@@ -162,12 +162,12 @@ typedef struct Object {
|
||||
/* Classes mixed into this object. */
|
||||
LIST_STATIC(Tcl_Obj *) filters;
|
||||
/* List of filter names. */
|
||||
struct Class *classPtr; /* This is non-NULL for all classes, and NULL
|
||||
* for everything else. It points to the class
|
||||
* structure. */
|
||||
struct Class *classPtr; /* All classes have this non-NULL; it points
|
||||
* to the class structure. Everything else has
|
||||
* this NULL. */
|
||||
int refCount; /* Number of strong references to this object.
|
||||
* Note that there may be many more weak
|
||||
* references; this mechanism exists to
|
||||
* references; this mechanism is there to
|
||||
* avoid Tcl_Preserve. */
|
||||
int flags;
|
||||
int creationEpoch; /* Unique value to make comparisons of objects
|
||||
@@ -193,10 +193,9 @@ typedef struct Object {
|
||||
* destroyed. */
|
||||
#define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been
|
||||
* called. */
|
||||
#define CLASS_GONE 4 /* Obsolete. Indicates that the class of this
|
||||
* object has been deleted, and so the object
|
||||
* should not attempt to remove itself from its
|
||||
* class. */
|
||||
#define CLASS_GONE 4 /* Indicates that the class of this object has
|
||||
* been deleted, and so the object should not
|
||||
* attempt to remove itself from its class. */
|
||||
#define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of
|
||||
* the class hierarchy and should be treated
|
||||
* specially during teardown. */
|
||||
@@ -223,6 +222,10 @@ typedef struct Object {
|
||||
typedef struct Class {
|
||||
Object *thisPtr; /* Reference to the object associated with
|
||||
* this class. */
|
||||
int refCount; /* Number of strong references to this class.
|
||||
* Weak references are not counted; the
|
||||
* purpose of this is to avoid Tcl_Preserve as
|
||||
* that is quite slow. */
|
||||
int flags; /* Assorted flags. */
|
||||
LIST_STATIC(struct Class *) superclasses;
|
||||
/* List of superclasses, used for generation
|
||||
@@ -320,7 +323,7 @@ typedef struct Foundation {
|
||||
} Foundation;
|
||||
|
||||
/*
|
||||
* A call context structure is built when a method is called. It contains the
|
||||
* A call context structure is built when a method is called. They contain the
|
||||
* chain of method implementations that are to be invoked by a particular
|
||||
* call, and the process of calling walks the chain, with the [next] command
|
||||
* proceeding to the next entry in the chain.
|
||||
@@ -331,7 +334,7 @@ typedef struct Foundation {
|
||||
struct MInvoke {
|
||||
Method *mPtr; /* Reference to the method implementation
|
||||
* record. */
|
||||
int isFilter; /* Whether this is a filter invocation. */
|
||||
int isFilter; /* Whether this is a filter invokation. */
|
||||
Class *filterDeclarer; /* What class decided to add the filter; if
|
||||
* NULL, it was added by the object. */
|
||||
};
|
||||
@@ -428,9 +431,6 @@ MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData,
|
||||
MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
@@ -492,11 +492,6 @@ MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
|
||||
const char *nsNameStr, int objc,
|
||||
Tcl_Obj *const *objv, int skip,
|
||||
Tcl_Object *objectPtr);
|
||||
MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp,
|
||||
Class *classPtr,
|
||||
const char *nameStr,
|
||||
const char *nsNameStr);
|
||||
MODULE_SCOPE int TclOODecrRefCount(Object *oPtr);
|
||||
MODULE_SCOPE int TclOODefineSlots(Foundation *fPtr);
|
||||
MODULE_SCOPE void TclOODeleteChain(CallChain *callPtr);
|
||||
MODULE_SCOPE void TclOODeleteChainCache(Tcl_HashTable *tablePtr);
|
||||
@@ -526,10 +521,10 @@ MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp,
|
||||
MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
|
||||
const DeclaredClassMethod *dcm);
|
||||
MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromMixinSubs(Class *subPtr,
|
||||
MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
|
||||
MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr,
|
||||
Class *mixinPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromSubclasses(Class *subPtr,
|
||||
MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr,
|
||||
Class *superPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclOORenderCallChain(Tcl_Interp *interp,
|
||||
CallChain *callPtr);
|
||||
@@ -543,22 +538,19 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
|
||||
|
||||
#include "tclOOIntDecls.h"
|
||||
|
||||
/*
|
||||
* Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
|
||||
*/
|
||||
|
||||
#define AddRef(ptr) ((ptr)->refCount++)
|
||||
|
||||
/*
|
||||
* A convenience macro for iterating through the lists used in the internal
|
||||
* memory management of objects.
|
||||
* memory management of objects. This is a bit gnarly because we want to do
|
||||
* the assignment of the picked-out value only when the body test succeeds,
|
||||
* but we cannot rely on the assigned value being useful, forcing us to do
|
||||
* some nasty stuff with the comma operator. The compiler's optimizer should
|
||||
* be able to sort it all out!
|
||||
*
|
||||
* REQUIRES DECLARATION: int i;
|
||||
*/
|
||||
|
||||
#define FOREACH(var,ary) \
|
||||
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
|
||||
continue; \
|
||||
} else if (var = (ary).list[i], 1)
|
||||
for(i=0 ; (i<(ary).num?((var=(ary).list[i]),1):0) ; i++)
|
||||
|
||||
/*
|
||||
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
|
||||
@@ -593,6 +585,17 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
/*
|
||||
* Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
|
||||
*/
|
||||
|
||||
#define AddRef(ptr) ((ptr)->refCount++)
|
||||
#define DelRef(ptr) do { \
|
||||
if ((ptr)->refCount-- <= 1) { \
|
||||
ckfree(ptr); \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
#endif /* TCL_OO_INTERNAL_H */
|
||||
|
||||
/*
|
||||
|
||||
@@ -1314,7 +1314,6 @@ CloneProcedureMethod(
|
||||
*/
|
||||
|
||||
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
|
||||
Tcl_GetString(bodyObj);
|
||||
TclFreeIntRep(bodyObj);
|
||||
|
||||
/*
|
||||
|
||||
+205
-91
@@ -75,7 +75,7 @@ typedef struct ObjData {
|
||||
* The structure defined below is used in this file only.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ThreadSpecificData {
|
||||
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
|
||||
* generated by a call to the function
|
||||
* TclSubstTokens() from a literal text
|
||||
@@ -210,8 +210,9 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfInt(Tcl_Obj *objPtr);
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
|
||||
static void UpdateStringOfOldInt(Tcl_Obj *objPtr);
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
|
||||
static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
#endif
|
||||
static void FreeBignum(Tcl_Obj *objPtr);
|
||||
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
|
||||
@@ -241,7 +242,6 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
* implementations.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
static const Tcl_ObjType oldBooleanType = {
|
||||
"boolean", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
@@ -249,7 +249,6 @@ static const Tcl_ObjType oldBooleanType = {
|
||||
NULL, /* updateStringProc */
|
||||
TclSetBooleanFromAny /* setFromAnyProc */
|
||||
};
|
||||
#endif
|
||||
const Tcl_ObjType tclBooleanType = {
|
||||
"booleanString", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
@@ -265,23 +264,19 @@ const Tcl_ObjType tclDoubleType = {
|
||||
SetDoubleFromAny /* setFromAnyProc */
|
||||
};
|
||||
const Tcl_ObjType tclIntType = {
|
||||
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
|
||||
"int", /* name */
|
||||
#else
|
||||
"wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
|
||||
#endif
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
UpdateStringOfInt, /* updateStringProc */
|
||||
SetIntFromAny /* setFromAnyProc */
|
||||
};
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
|
||||
static const Tcl_ObjType oldIntType = {
|
||||
"int", /* name */
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
const Tcl_ObjType tclWideIntType = {
|
||||
"wideInt", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
UpdateStringOfOldInt, /* updateStringProc */
|
||||
SetIntFromAny /* setFromAnyProc */
|
||||
UpdateStringOfWideInt, /* updateStringProc */
|
||||
SetWideIntFromAny /* setFromAnyProc */
|
||||
};
|
||||
#endif
|
||||
const Tcl_ObjType tclBignumType = {
|
||||
@@ -349,17 +344,17 @@ typedef struct ResolvedCmdName {
|
||||
* reference (not the namespace that contains
|
||||
* the referenced command). NULL if the name
|
||||
* is fully qualified.*/
|
||||
unsigned long refNsId; /* refNsPtr's unique namespace id. Used to
|
||||
long refNsId; /* refNsPtr's unique namespace id. Used to
|
||||
* verify that refNsPtr is still valid (e.g.,
|
||||
* it's possible that the cmd's containing
|
||||
* namespace was deleted and a new one created
|
||||
* at the same address). */
|
||||
unsigned int refNsCmdEpoch; /* Value of the referencing namespace's
|
||||
int refNsCmdEpoch; /* Value of the referencing namespace's
|
||||
* cmdRefEpoch when the pointer was cached.
|
||||
* Before using the cached pointer, we check
|
||||
* if the namespace's epoch was incremented;
|
||||
* if so, this cached pointer is invalid. */
|
||||
unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this
|
||||
int cmdEpoch; /* Value of the command's cmdEpoch when this
|
||||
* pointer was cached. Before using the cached
|
||||
* pointer, we check if the cmd's epoch was
|
||||
* incremented; if so, the cmd was renamed,
|
||||
@@ -400,6 +395,8 @@ TclInitObjSubsystem(void)
|
||||
|
||||
Tcl_RegisterObjType(&tclByteArrayType);
|
||||
Tcl_RegisterObjType(&tclDoubleType);
|
||||
Tcl_RegisterObjType(&tclEndOffsetType);
|
||||
Tcl_RegisterObjType(&tclIntType);
|
||||
Tcl_RegisterObjType(&tclStringType);
|
||||
Tcl_RegisterObjType(&tclListType);
|
||||
Tcl_RegisterObjType(&tclDictType);
|
||||
@@ -409,12 +406,9 @@ TclInitObjSubsystem(void)
|
||||
Tcl_RegisterObjType(&tclProcBodyType);
|
||||
|
||||
/* For backward compatibility only ... */
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Tcl_RegisterObjType(&tclIntType);
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG)
|
||||
Tcl_RegisterObjType(&oldIntType);
|
||||
#endif
|
||||
Tcl_RegisterObjType(&oldBooleanType);
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
Tcl_RegisterObjType(&tclWideIntType);
|
||||
#endif
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
@@ -1738,7 +1732,7 @@ Tcl_InvalidateStringRep(
|
||||
* is coerced to 1.
|
||||
*
|
||||
* When TCL_MEM_DEBUG is defined, this function just returns the result
|
||||
* of calling the debugging version Tcl_DbNewLongObj.
|
||||
* of calling the debugging version Tcl_DbNewBooleanObj.
|
||||
*
|
||||
* Results:
|
||||
* The newly created object is returned. This object will have an invalid
|
||||
@@ -1757,7 +1751,7 @@ Tcl_Obj *
|
||||
Tcl_NewBooleanObj(
|
||||
register int boolValue) /* Boolean used to initialize new object. */
|
||||
{
|
||||
return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
|
||||
return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
|
||||
}
|
||||
|
||||
#else /* if not TCL_MEM_DEBUG */
|
||||
@@ -1768,7 +1762,7 @@ Tcl_NewBooleanObj(
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, boolValue!=0);
|
||||
TclNewBooleanObj(objPtr, boolValue);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* TCL_MEM_DEBUG */
|
||||
@@ -1799,7 +1793,6 @@ Tcl_NewBooleanObj(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
#undef Tcl_DbNewBooleanObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
@@ -1816,7 +1809,7 @@ Tcl_DbNewBooleanObj(
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
|
||||
objPtr->internalRep.wideValue = (boolValue != 0);
|
||||
objPtr->internalRep.longValue = (boolValue != 0);
|
||||
objPtr->typePtr = &tclIntType;
|
||||
return objPtr;
|
||||
}
|
||||
@@ -1863,9 +1856,8 @@ Tcl_SetBooleanObj(
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
|
||||
}
|
||||
|
||||
TclSetIntObj(objPtr, boolValue!=0);
|
||||
TclSetBooleanObj(objPtr, boolValue);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -1894,11 +1886,11 @@ Tcl_GetBooleanFromObj(
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*boolPtr = (objPtr->internalRep.wideValue != 0);
|
||||
*boolPtr = (objPtr->internalRep.longValue != 0);
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBooleanType) {
|
||||
*boolPtr = objPtr->internalRep.longValue != 0;
|
||||
*boolPtr = (int) objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
@@ -1922,6 +1914,12 @@ Tcl_GetBooleanFromObj(
|
||||
*boolPtr = 1;
|
||||
return TCL_OK;
|
||||
}
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
*boolPtr = (objPtr->internalRep.wideValue != 0);
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
|
||||
TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
|
||||
return TCL_ERROR;
|
||||
@@ -1942,12 +1940,7 @@ Tcl_GetBooleanFromObj(
|
||||
*
|
||||
* Side effects:
|
||||
* If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
|
||||
* representation and the type of "objPtr" is set to boolean or int/wideInt.
|
||||
*
|
||||
* Warning: If the returned type is "wideInt" (32-bit platforms) and your
|
||||
* platform is bigendian, you cannot use internalRep.longValue to distinguish
|
||||
* between false and true. On Windows and most other platforms this still will
|
||||
* work fine, but basically it is non-portable.
|
||||
* representation and the type of "objPtr" is set to boolean.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1965,7 +1958,8 @@ TclSetBooleanFromAny(
|
||||
|
||||
if (objPtr->bytes == NULL) {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
|
||||
switch (objPtr->internalRep.longValue) {
|
||||
case 0L: case 1L:
|
||||
return TCL_OK;
|
||||
}
|
||||
goto badBoolean;
|
||||
@@ -1975,6 +1969,12 @@ TclSetBooleanFromAny(
|
||||
goto badBoolean;
|
||||
}
|
||||
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
goto badBoolean;
|
||||
}
|
||||
#endif
|
||||
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
goto badBoolean;
|
||||
}
|
||||
@@ -2111,7 +2111,7 @@ ParseBoolean(
|
||||
|
||||
numericBoolean:
|
||||
TclFreeIntRep(objPtr);
|
||||
objPtr->internalRep.wideValue = newBool;
|
||||
objPtr->internalRep.longValue = newBool;
|
||||
objPtr->typePtr = &tclIntType;
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -2292,7 +2292,7 @@ Tcl_GetDoubleFromObj(
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*dblPtr = (double) objPtr->internalRep.wideValue;
|
||||
*dblPtr = objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
@@ -2302,6 +2302,12 @@ Tcl_GetDoubleFromObj(
|
||||
*dblPtr = TclBignumToDouble(&big);
|
||||
return TCL_OK;
|
||||
}
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
*dblPtr = (double) objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
} while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -2419,7 +2425,7 @@ Tcl_NewIntObj(
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, intValue);
|
||||
TclNewLongObj(objPtr, intValue);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* if TCL_MEM_DEBUG */
|
||||
@@ -2530,8 +2536,9 @@ SetIntFromAny(
|
||||
Tcl_Interp *interp, /* Tcl interpreter */
|
||||
Tcl_Obj *objPtr) /* Pointer to the object to convert */
|
||||
{
|
||||
Tcl_WideInt w;
|
||||
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
|
||||
long l;
|
||||
|
||||
return TclGetLongFromObj(interp, objPtr, &l);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2560,28 +2567,12 @@ UpdateStringOfInt(
|
||||
char buffer[TCL_INTEGER_SPACE];
|
||||
register int len;
|
||||
|
||||
len = TclFormatInt(buffer, objPtr->internalRep.wideValue);
|
||||
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
|
||||
static void
|
||||
UpdateStringOfOldInt(
|
||||
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
{
|
||||
char buffer[TCL_INTEGER_SPACE];
|
||||
register int len;
|
||||
|
||||
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
|
||||
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -2613,8 +2604,8 @@ UpdateStringOfOldInt(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_NewLongObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
#undef Tcl_NewLongObj
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewLongObj(
|
||||
@@ -2633,7 +2624,7 @@ Tcl_NewLongObj(
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, longValue);
|
||||
TclNewLongObj(objPtr, longValue);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* if TCL_MEM_DEBUG */
|
||||
@@ -2670,7 +2661,6 @@ Tcl_NewLongObj(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_DbNewLongObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
Tcl_Obj *
|
||||
@@ -2687,7 +2677,7 @@ Tcl_DbNewLongObj(
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
|
||||
objPtr->internalRep.wideValue = longValue;
|
||||
objPtr->internalRep.longValue = longValue;
|
||||
objPtr->typePtr = &tclIntType;
|
||||
return objPtr;
|
||||
}
|
||||
@@ -2725,7 +2715,6 @@ Tcl_DbNewLongObj(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_SetLongObj
|
||||
void
|
||||
Tcl_SetLongObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
@@ -2736,7 +2725,7 @@ Tcl_SetLongObj(
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
|
||||
}
|
||||
|
||||
TclSetIntObj(objPtr, longValue);
|
||||
TclSetLongObj(objPtr, longValue);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2767,13 +2756,12 @@ Tcl_GetLongFromObj(
|
||||
register long *longPtr) /* Place to store resulting long. */
|
||||
{
|
||||
do {
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*longPtr = objPtr->internalRep.wideValue;
|
||||
*longPtr = objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
#else
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
/*
|
||||
* We return any integer in the range -ULONG_MAX to ULONG_MAX
|
||||
* converted to a long, ignoring overflow. The rule preserves
|
||||
@@ -2846,6 +2834,49 @@ Tcl_GetLongFromObj(
|
||||
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* UpdateStringOfWideInt --
|
||||
*
|
||||
* Update the string representation for a wide integer object. Note: this
|
||||
* function does not free an existing old string rep so storage will be
|
||||
* lost if this has not already been done.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object's string is set to a valid string that results from the
|
||||
* wideInt-to-string conversion.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
UpdateStringOfWideInt(
|
||||
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
{
|
||||
char buffer[TCL_INTEGER_SPACE+2];
|
||||
register unsigned len;
|
||||
register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;
|
||||
|
||||
/*
|
||||
* Note that sprintf will generate a compiler warning under Mingw claiming
|
||||
* %I64 is an unknown format specifier. Just ignore this warning. We can't
|
||||
* use %L as the format specifier since that gets printed as a 32 bit
|
||||
* value.
|
||||
*/
|
||||
|
||||
sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
|
||||
len = strlen(buffer);
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
#endif /* !TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -2895,7 +2926,7 @@ Tcl_NewWideIntObj(
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewObj(objPtr);
|
||||
TclSetIntObj(objPtr, wideValue);
|
||||
Tcl_SetWideIntObj(objPtr, wideValue);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* if TCL_MEM_DEBUG */
|
||||
@@ -2947,7 +2978,7 @@ Tcl_DbNewWideIntObj(
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
TclSetIntObj(objPtr, wideValue);
|
||||
Tcl_SetWideIntObj(objPtr, wideValue);
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
@@ -2996,7 +3027,19 @@ Tcl_SetWideIntObj(
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
|
||||
}
|
||||
|
||||
TclSetIntObj(objPtr, wideValue);
|
||||
if ((wideValue >= (Tcl_WideInt) LONG_MIN)
|
||||
&& (wideValue <= (Tcl_WideInt) LONG_MAX)) {
|
||||
TclSetLongObj(objPtr, (long) wideValue);
|
||||
} else {
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
TclSetWideIntObj(objPtr, wideValue);
|
||||
#else
|
||||
mp_int big;
|
||||
|
||||
TclBNInitBignumFromWideInt(&big, wideValue);
|
||||
Tcl_SetBignumObj(objPtr, &big);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3028,10 +3071,16 @@ Tcl_GetWideIntFromObj(
|
||||
/* Place to store resulting long. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
*wideIntPtr = objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -3082,6 +3131,33 @@ Tcl_GetWideIntFromObj(
|
||||
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* SetWideIntFromAny --
|
||||
*
|
||||
* Attempts to force the internal representation for a Tcl object to
|
||||
* tclWideIntType, specifically.
|
||||
*
|
||||
* Results:
|
||||
* The return value is a standard object Tcl result. If an error occurs
|
||||
* during conversion, an error message is left in the interpreter's
|
||||
* result unless "interp" is NULL.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
SetWideIntFromAny(
|
||||
Tcl_Interp *interp, /* Tcl interpreter */
|
||||
Tcl_Obj *objPtr) /* Pointer to the object to convert */
|
||||
{
|
||||
Tcl_WideInt w;
|
||||
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
|
||||
}
|
||||
#endif /* !TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -3324,10 +3400,16 @@ GetBignumFromObj(
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
TclInitBignumFromWideInt(bignumValue,
|
||||
TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
|
||||
return TCL_OK;
|
||||
}
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
TclBNInitBignumFromWideInt(bignumValue,
|
||||
objPtr->internalRep.wideValue);
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -3437,12 +3519,37 @@ Tcl_SetBignumObj(
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
|
||||
}
|
||||
if ((size_t) bignumValue->used
|
||||
<= (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
|
||||
Tcl_WideUInt value = 0;
|
||||
unsigned long numBytes = sizeof(Tcl_WideUInt);
|
||||
Tcl_WideUInt scratch;
|
||||
<= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
|
||||
unsigned long value = 0, numBytes = sizeof(long);
|
||||
long scratch;
|
||||
unsigned char *bytes = (unsigned char *) &scratch;
|
||||
|
||||
if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
|
||||
goto tooLargeForLong;
|
||||
}
|
||||
while (numBytes-- > 0) {
|
||||
value = (value << CHAR_BIT) | *bytes++;
|
||||
}
|
||||
if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
|
||||
goto tooLargeForLong;
|
||||
}
|
||||
if (bignumValue->sign) {
|
||||
TclSetLongObj(objPtr, -(long)value);
|
||||
} else {
|
||||
TclSetLongObj(objPtr, (long)value);
|
||||
}
|
||||
mp_clear(bignumValue);
|
||||
return;
|
||||
}
|
||||
tooLargeForLong:
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if ((size_t) bignumValue->used
|
||||
<= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
|
||||
Tcl_WideUInt value = 0;
|
||||
unsigned long numBytes = sizeof(Tcl_WideInt);
|
||||
Tcl_WideInt scratch;
|
||||
unsigned char *bytes = (unsigned char *)&scratch;
|
||||
|
||||
if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
|
||||
goto tooLargeForWide;
|
||||
}
|
||||
@@ -3453,14 +3560,15 @@ Tcl_SetBignumObj(
|
||||
goto tooLargeForWide;
|
||||
}
|
||||
if (bignumValue->sign) {
|
||||
TclSetIntObj(objPtr, -(Tcl_WideInt)value);
|
||||
TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
|
||||
} else {
|
||||
TclSetIntObj(objPtr, (Tcl_WideInt)value);
|
||||
TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
|
||||
}
|
||||
mp_clear(bignumValue);
|
||||
return;
|
||||
}
|
||||
tooLargeForWide:
|
||||
#endif
|
||||
TclInvalidateStringRep(objPtr);
|
||||
TclFreeIntRep(objPtr);
|
||||
TclSetBignumIntRep(objPtr, bignumValue);
|
||||
@@ -3542,10 +3650,17 @@ TclGetNumberFromObj(
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*typePtr = TCL_NUMBER_LONG;
|
||||
*clientDataPtr = &objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
if (objPtr->typePtr == &tclWideIntType) {
|
||||
*typePtr = TCL_NUMBER_WIDE;
|
||||
*clientDataPtr = &objPtr->internalRep.wideValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif
|
||||
if (objPtr->typePtr == &tclBignumType) {
|
||||
static Tcl_ThreadDataKey bignumKey;
|
||||
mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
|
||||
@@ -4338,6 +4453,7 @@ Tcl_RepresentationCmd(
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
char ptrBuffer[2*TCL_INTEGER_SPACE+6];
|
||||
Tcl_Obj *descObj;
|
||||
|
||||
if (objc != 2) {
|
||||
@@ -4351,20 +4467,18 @@ Tcl_RepresentationCmd(
|
||||
* "1872361827361287"
|
||||
*/
|
||||
|
||||
sprintf(ptrBuffer, "%p", (void *) objv[1]);
|
||||
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
|
||||
" object pointer at %p",
|
||||
objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
|
||||
objv[1]->refCount, objv[1]);
|
||||
" object pointer at %s",
|
||||
objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
|
||||
objv[1]->refCount, ptrBuffer);
|
||||
|
||||
if (objv[1]->typePtr) {
|
||||
if (objv[1]->typePtr == &tclDoubleType) {
|
||||
Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
|
||||
objv[1]->internalRep.doubleValue);
|
||||
} else {
|
||||
Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
|
||||
(void *) objv[1]->internalRep.twoPtrValue.ptr1,
|
||||
(void *) objv[1]->internalRep.twoPtrValue.ptr2);
|
||||
}
|
||||
sprintf(ptrBuffer, "%p:%p",
|
||||
(void *) objv[1]->internalRep.twoPtrValue.ptr1,
|
||||
(void *) objv[1]->internalRep.twoPtrValue.ptr2);
|
||||
Tcl_AppendPrintfToObj(descObj, ", internal representation %s",
|
||||
ptrBuffer);
|
||||
}
|
||||
|
||||
if (objv[1]->bytes) {
|
||||
|
||||
+1
-1
@@ -111,7 +111,7 @@ Tcl_PanicVA(
|
||||
__builtin_trap();
|
||||
# elif defined(_WIN64)
|
||||
__debugbreak();
|
||||
# elif defined(_MSC_VER) && defined (_M_IX86)
|
||||
# elif defined(_MSC_VER)
|
||||
_asm {int 3}
|
||||
# else
|
||||
DebugBreak();
|
||||
|
||||
+4
-7
@@ -829,7 +829,7 @@ TclParseBackslash(
|
||||
* written there. */
|
||||
{
|
||||
register const char *p = src+1;
|
||||
Tcl_UniChar unichar = 0;
|
||||
Tcl_UniChar unichar;
|
||||
int result;
|
||||
int count;
|
||||
char buf[TCL_UTF_MAX];
|
||||
@@ -963,13 +963,13 @@ TclParseBackslash(
|
||||
*/
|
||||
|
||||
if (Tcl_UtfCharComplete(p, numBytes - 1)) {
|
||||
count = TclUtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
|
||||
count = Tcl_UtfToUniChar(p, &unichar) + 1; /* +1 for '\' */
|
||||
} else {
|
||||
char utfBytes[TCL_UTF_MAX];
|
||||
|
||||
memcpy(utfBytes, p, (size_t) (numBytes - 1));
|
||||
utfBytes[numBytes - 1] = '\0';
|
||||
count = TclUtfToUniChar(utfBytes, &unichar) + 1;
|
||||
count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
|
||||
}
|
||||
result = unichar;
|
||||
break;
|
||||
@@ -1169,8 +1169,6 @@ ParseTokens(
|
||||
numBytes--;
|
||||
nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
|
||||
while (1) {
|
||||
const char *curEnd;
|
||||
|
||||
if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
|
||||
nestedPtr) != TCL_OK) {
|
||||
parsePtr->errorType = nestedPtr->errorType;
|
||||
@@ -1179,9 +1177,8 @@ ParseTokens(
|
||||
TclStackFree(parsePtr->interp, nestedPtr);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
curEnd = src + numBytes;
|
||||
src = nestedPtr->commandStart + nestedPtr->commandSize;
|
||||
numBytes = curEnd - src;
|
||||
numBytes = parsePtr->end - src;
|
||||
Tcl_FreeParse(nestedPtr);
|
||||
|
||||
/*
|
||||
|
||||
+36
-50
@@ -13,7 +13,6 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
#include "tclFileSystem.h"
|
||||
#include <assert.h>
|
||||
|
||||
/*
|
||||
* Prototypes for functions defined later in this file.
|
||||
@@ -850,20 +849,18 @@ TclJoinPath(
|
||||
int elements,
|
||||
Tcl_Obj * const objv[])
|
||||
{
|
||||
Tcl_Obj *res = NULL;
|
||||
Tcl_Obj *res;
|
||||
int i;
|
||||
const Tcl_Filesystem *fsPtr = NULL;
|
||||
|
||||
assert ( elements >= 0 );
|
||||
res = NULL;
|
||||
|
||||
if (elements == 0) {
|
||||
return Tcl_NewObj();
|
||||
}
|
||||
|
||||
assert ( elements > 0 );
|
||||
|
||||
if (elements == 2) {
|
||||
Tcl_Obj *elt = objv[0];
|
||||
for (i = 0; i < elements; i++) {
|
||||
int driveNameLength, strEltLen, length;
|
||||
Tcl_PathType type;
|
||||
char *strElt, *ptr;
|
||||
Tcl_Obj *driveName = NULL;
|
||||
Tcl_Obj *elt = objv[i];
|
||||
|
||||
/*
|
||||
* This is a special case where we can be much more efficient, where
|
||||
@@ -872,17 +869,18 @@ TclJoinPath(
|
||||
* object which can be normalized more efficiently. Currently we only
|
||||
* use the special case when we have exactly two elements, but we
|
||||
* could expand that in the future.
|
||||
*
|
||||
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
|
||||
* to be an absolute path. Added a check for that elt is absolute.
|
||||
*
|
||||
* Bugfix [a47641a0]. TclNewFSPathObj requires first argument
|
||||
* to be an absolute path. Added a check for that elt is absolute.
|
||||
*/
|
||||
|
||||
if ((elt->typePtr == &tclFsPathType)
|
||||
if ((i == (elements-2)) && (i == 0)
|
||||
&& (elt->typePtr == &tclFsPathType)
|
||||
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
|
||||
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
|
||||
Tcl_Obj *tailObj = objv[1];
|
||||
Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL);
|
||||
Tcl_Obj *tailObj = objv[i+1];
|
||||
|
||||
type = TclGetPathType(tailObj, NULL, NULL, NULL);
|
||||
if (type == TCL_PATH_RELATIVE) {
|
||||
const char *str;
|
||||
int len;
|
||||
@@ -895,6 +893,9 @@ TclJoinPath(
|
||||
* the base itself is just fine!
|
||||
*/
|
||||
|
||||
if (res != NULL) {
|
||||
TclDecrRefCount(res);
|
||||
}
|
||||
return elt;
|
||||
}
|
||||
|
||||
@@ -917,17 +918,10 @@ TclJoinPath(
|
||||
|
||||
if ((tclPlatform != TCL_PLATFORM_WINDOWS)
|
||||
|| (strchr(Tcl_GetString(elt), '\\') == NULL)) {
|
||||
|
||||
if (PATHFLAGS(elt)) {
|
||||
return TclNewFSPathObj(elt, str, len);
|
||||
}
|
||||
if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
|
||||
return TclNewFSPathObj(elt, str, len);
|
||||
}
|
||||
(void) Tcl_FSGetNormalizedPath(NULL, elt);
|
||||
if (elt == PATHOBJ(elt)->normPathPtr) {
|
||||
return TclNewFSPathObj(elt, str, len);
|
||||
if (res != NULL) {
|
||||
TclDecrRefCount(res);
|
||||
}
|
||||
return TclNewFSPathObj(elt, str, len);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -936,30 +930,24 @@ TclJoinPath(
|
||||
* more general code below handle things.
|
||||
*/
|
||||
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
|
||||
if (res != NULL) {
|
||||
TclDecrRefCount(res);
|
||||
}
|
||||
return tailObj;
|
||||
} else {
|
||||
const char *str = TclGetString(tailObj);
|
||||
|
||||
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
|
||||
if (strchr(str, '\\') == NULL) {
|
||||
if (res != NULL) {
|
||||
TclDecrRefCount(res);
|
||||
}
|
||||
return tailObj;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
assert ( res == NULL );
|
||||
|
||||
for (i = 0; i < elements; i++) {
|
||||
int driveNameLength, strEltLen, length;
|
||||
Tcl_PathType type;
|
||||
char *strElt, *ptr;
|
||||
Tcl_Obj *driveName = NULL;
|
||||
Tcl_Obj *elt = objv[i];
|
||||
|
||||
strElt = TclGetStringFromObj(elt, &strEltLen);
|
||||
driveNameLength = 0;
|
||||
type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
|
||||
if (type != TCL_PATH_RELATIVE) {
|
||||
/*
|
||||
@@ -1015,12 +1003,6 @@ TclJoinPath(
|
||||
}
|
||||
}
|
||||
ptr = strElt;
|
||||
/* [Bug f34cf83dd0] */
|
||||
if (driveNameLength > 0) {
|
||||
if (ptr[0] == '/' && ptr[-1] == '/') {
|
||||
goto noQuickReturn;
|
||||
}
|
||||
}
|
||||
while (*ptr != '\0') {
|
||||
if (*ptr == '/' && (ptr[1] == '/' || ptr[1] == '\0')) {
|
||||
/*
|
||||
@@ -1052,8 +1034,10 @@ TclJoinPath(
|
||||
noQuickReturn:
|
||||
if (res == NULL) {
|
||||
res = Tcl_NewObj();
|
||||
ptr = TclGetStringFromObj(res, &length);
|
||||
} else {
|
||||
ptr = TclGetStringFromObj(res, &length);
|
||||
}
|
||||
ptr = TclGetStringFromObj(res, &length);
|
||||
|
||||
/*
|
||||
* Strip off any './' before a tilde, unless this is the beginning of
|
||||
@@ -1086,7 +1070,6 @@ TclJoinPath(
|
||||
|
||||
if (sep != NULL) {
|
||||
separator = TclGetString(sep)[0];
|
||||
TclDecrRefCount(sep);
|
||||
}
|
||||
/* Safety check in case the VFS driver caused sharing */
|
||||
if (Tcl_IsShared(res)) {
|
||||
@@ -1122,7 +1105,9 @@ TclJoinPath(
|
||||
Tcl_SetObjLength(res, length);
|
||||
}
|
||||
}
|
||||
assert ( res != NULL );
|
||||
if (res == NULL) {
|
||||
res = Tcl_NewObj();
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
@@ -1809,6 +1794,7 @@ Tcl_FSGetNormalizedPath(
|
||||
*/
|
||||
|
||||
(void) TclGetStringFromObj(dir, &cwdLen);
|
||||
cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
|
||||
|
||||
/* Normalize the combined string. */
|
||||
|
||||
@@ -1830,12 +1816,12 @@ Tcl_FSGetNormalizedPath(
|
||||
* normalized head, we can more efficiently normalize the combined
|
||||
* path by passing over only the unnormalized tail portion. When
|
||||
* this is sufficient, prior developers claim this should be much
|
||||
* faster. We use 'cwdLen' so that we are already pointing at
|
||||
* faster. We use 'cwdLen-1' so that we are already pointing at
|
||||
* the dir-separator that we know about. The normalization code
|
||||
* will actually start off directly after that separator.
|
||||
*/
|
||||
|
||||
TclFSNormalizeToUniquePath(interp, copy, cwdLen);
|
||||
TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
|
||||
}
|
||||
|
||||
/* Now we need to construct the new path object. */
|
||||
|
||||
+58
-28
@@ -221,13 +221,13 @@ Tcl_ReapDetachedProcs(void)
|
||||
{
|
||||
register Detached *detPtr;
|
||||
Detached *nextPtr, *prevPtr;
|
||||
int status, code;
|
||||
int status;
|
||||
Tcl_Pid pid;
|
||||
|
||||
Tcl_MutexLock(&pipeMutex);
|
||||
for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
|
||||
status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL);
|
||||
if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR
|
||||
&& code != ECHILD)) {
|
||||
pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
|
||||
if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
|
||||
prevPtr = detPtr;
|
||||
detPtr = detPtr->nextPtr;
|
||||
continue;
|
||||
@@ -277,21 +277,38 @@ TclCleanupChildren(
|
||||
{
|
||||
int result = TCL_OK;
|
||||
int i, abnormalExit, anyErrorInfo;
|
||||
TclProcessWaitStatus waitStatus;
|
||||
int code;
|
||||
Tcl_Obj *msg, *error;
|
||||
Tcl_Pid pid;
|
||||
int waitStatus;
|
||||
const char *msg;
|
||||
unsigned long resolvedPid;
|
||||
|
||||
abnormalExit = 0;
|
||||
for (i = 0; i < numPids; i++) {
|
||||
waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
|
||||
if (waitStatus == TCL_PROCESS_ERROR) {
|
||||
/*
|
||||
* We need to get the resolved pid before we wait on it as the windows
|
||||
* implementation of Tcl_WaitPid deletes the information such that any
|
||||
* following calls to TclpGetPid fail.
|
||||
*/
|
||||
|
||||
resolvedPid = TclpGetPid(pidPtr[i]);
|
||||
pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0);
|
||||
if (pid == (Tcl_Pid) -1) {
|
||||
result = TCL_ERROR;
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjErrorCode(interp, error);
|
||||
Tcl_SetObjResult(interp, msg);
|
||||
msg = Tcl_PosixError(interp);
|
||||
if (errno == ECHILD) {
|
||||
/*
|
||||
* This changeup in message suggested by Mark Diekhans to
|
||||
* remind people that ECHILD errors can occur on some
|
||||
* systems if SIGCHLD isn't in its default state.
|
||||
*/
|
||||
|
||||
msg =
|
||||
"child process lost (is SIGCHLD ignored or trapped?)";
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"error waiting for process to exit: %s", msg));
|
||||
}
|
||||
Tcl_DecrRefCount(error);
|
||||
Tcl_DecrRefCount(msg);
|
||||
continue;
|
||||
}
|
||||
|
||||
@@ -302,19 +319,39 @@ TclCleanupChildren(
|
||||
* removed).
|
||||
*/
|
||||
|
||||
if (waitStatus != TCL_PROCESS_EXITED || code != 0) {
|
||||
if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
|
||||
char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
|
||||
|
||||
result = TCL_ERROR;
|
||||
if (waitStatus == TCL_PROCESS_EXITED) {
|
||||
sprintf(msg1, "%lu", resolvedPid);
|
||||
if (WIFEXITED(waitStatus)) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjErrorCode(interp, error);
|
||||
sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
|
||||
Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
|
||||
}
|
||||
abnormalExit = 1;
|
||||
} else if (interp != NULL) {
|
||||
Tcl_SetObjErrorCode(interp, error);
|
||||
Tcl_SetObjResult(interp, msg);
|
||||
const char *p;
|
||||
|
||||
if (WIFSIGNALED(waitStatus)) {
|
||||
p = Tcl_SignalMsg(WTERMSIG(waitStatus));
|
||||
Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
|
||||
Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"child killed: %s\n", p));
|
||||
} else if (WIFSTOPPED(waitStatus)) {
|
||||
p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
|
||||
Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
|
||||
Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"child suspended: %s\n", p));
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"child wait status didn't make sense\n", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
|
||||
"ODDWAITRESULT", msg1, NULL);
|
||||
}
|
||||
}
|
||||
Tcl_DecrRefCount(error);
|
||||
Tcl_DecrRefCount(msg);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -631,13 +668,7 @@ TclCreatePipeline(
|
||||
if (*p == '>') {
|
||||
p++;
|
||||
atOK = 0;
|
||||
|
||||
/*
|
||||
* Note that the O_APPEND flag only has an effect on POSIX
|
||||
* platforms. On Windows, we just have to carry on regardless.
|
||||
*/
|
||||
|
||||
flags = O_WRONLY | O_CREAT | O_APPEND;
|
||||
flags = O_WRONLY | O_CREAT;
|
||||
}
|
||||
if (errorClose != 0) {
|
||||
errorClose = 0;
|
||||
@@ -899,7 +930,6 @@ TclCreatePipeline(
|
||||
|
||||
pidPtr[numPids] = pid;
|
||||
numPids++;
|
||||
TclProcessCreated(pid);
|
||||
|
||||
/*
|
||||
* Close off our copies of file descriptors that were set up for this
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user