Compare commits
2
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
 fvogel
|
d8cae66217 | ||
|
fvogel
|
40ce2eccbc |
@@ -12,8 +12,6 @@ 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
|
||||
@@ -12,8 +12,6 @@ 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
|
||||
-138
@@ -1,138 +0,0 @@
|
||||
sudo: false
|
||||
language: c
|
||||
|
||||
matrix:
|
||||
include:
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: clang
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: clang
|
||||
env:
|
||||
- CFGOPT=--disable-shared
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: gcc
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: gcc
|
||||
env:
|
||||
- CFGOPT=--disable-shared
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: gcc-4.9
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-4.9
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: gcc-5
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-5
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: gcc-6
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-6
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: gcc-7
|
||||
addons:
|
||||
apt:
|
||||
sources:
|
||||
- ubuntu-toolchain-r-test
|
||||
packages:
|
||||
- g++-7
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: osx
|
||||
osx_image: xcode8
|
||||
env:
|
||||
- BUILD_DIR=unix
|
||||
- os: osx
|
||||
osx_image: xcode8
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
- NO_DIRECT_CONFIGURE=1
|
||||
- os: osx
|
||||
osx_image: xcode9
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
- NO_DIRECT_CONFIGURE=1
|
||||
- os: osx
|
||||
osx_image: xcode10.2
|
||||
env:
|
||||
- BUILD_DIR=macosx
|
||||
- NO_DIRECT_CONFIGURE=1
|
||||
### C builds not currently supported on Windows instances
|
||||
# - os: windows
|
||||
# env:
|
||||
# - BUILD_DIR=win
|
||||
### ... so proxy with a Mingw cross-compile
|
||||
# Test with mingw-w64 (32 bit)
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: i686-w64-mingw32-gcc
|
||||
addons:
|
||||
apt:
|
||||
packages:
|
||||
- gcc-mingw-w64-base
|
||||
- binutils-mingw-w64-i686
|
||||
- gcc-mingw-w64-i686
|
||||
- gcc-mingw-w64
|
||||
- gcc-multilib
|
||||
- wine
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT=--host=i686-w64-mingw32
|
||||
- NO_DIRECT_TEST=1
|
||||
# Test with mingw-w64 (64 bit)
|
||||
- os: linux
|
||||
dist: xenial
|
||||
compiler: x86_64-w64-mingw32-gcc
|
||||
addons:
|
||||
apt:
|
||||
packages:
|
||||
- gcc-mingw-w64-base
|
||||
- binutils-mingw-w64-x86-64
|
||||
- gcc-mingw-w64-x86-64
|
||||
- gcc-mingw-w64
|
||||
- wine
|
||||
env:
|
||||
- BUILD_DIR=win
|
||||
- CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
|
||||
- NO_DIRECT_TEST=1
|
||||
|
||||
before_install:
|
||||
- export ERROR_ON_FAILURES=1
|
||||
- cd ${BUILD_DIR}
|
||||
install:
|
||||
- test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
|
||||
script:
|
||||
- make
|
||||
# The styles=develop avoids some weird problems on OSX
|
||||
- test -n "$NO_DIRECT_TEST" || make test styles=develop
|
||||
@@ -1,6 +1,6 @@
|
||||
A NOTE ON THE CHANGELOG:
|
||||
Starting in early 2011, Tcl source code has been under the management of
|
||||
fossil, hosted at https://core.tcl-lang.org/tcl/ . Fossil presents a "Timeline"
|
||||
fossil, hosted at http://core.tcl.tk/tcl/ . Fossil presents a "Timeline"
|
||||
view of changes made that is superior in every way to a hand edited log file.
|
||||
Because of this, many Tcl developers are now out of the habit of maintaining
|
||||
this log file. You may still find useful things in it, but the Timeline is
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
README: Tcl
|
||||
This is the Tcl 8.6.9 source distribution.
|
||||
This is the Tcl 8.6.7 source distribution.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
You can get any source release of Tcl from the URL above.
|
||||
|
||||
@@ -29,7 +29,7 @@ Tcl is maintained, enhanced, and distributed freely by the Tcl community.
|
||||
Source code development and tracking of bug reports and feature requests
|
||||
takes place at:
|
||||
|
||||
http://core.tcl-lang.org/
|
||||
http://core.tcl.tk/
|
||||
|
||||
Tcl/Tk release and mailing list services are hosted by SourceForge:
|
||||
|
||||
@@ -37,7 +37,7 @@ Tcl/Tk release and mailing list services are hosted by SourceForge:
|
||||
|
||||
with the Tcl Developer Xchange hosted at:
|
||||
|
||||
http://www.tcl-lang.org/
|
||||
http://www.tcl.tk/
|
||||
|
||||
Tcl is a freely available open source package. You can do virtually
|
||||
anything you like with it, such as modifying it, redistributing it,
|
||||
@@ -49,21 +49,21 @@ and selling it either in whole or in part. See the file
|
||||
|
||||
Extensive documentation is available at our website.
|
||||
The home page for this release, including new features, is
|
||||
http://www.tcl-lang.org/software/tcltk/8.6.html
|
||||
http://www.tcl.tk/software/tcltk/8.6.html
|
||||
|
||||
Detailed release notes can be found at the file distributions page
|
||||
by clicking on the relevant version.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
|
||||
Information about Tcl itself can be found at
|
||||
http://www.tcl-lang.org/about/
|
||||
http://www.tcl.tk/about/
|
||||
|
||||
There have been many Tcl books on the market. Many are mentioned in the Wiki:
|
||||
http://wiki.tcl-lang.org/_/ref?N=25206
|
||||
http://wiki.tcl.tk/_/ref?N=25206
|
||||
|
||||
To view the complete set of reference manual entries for Tcl 8.6 online,
|
||||
visit the URL:
|
||||
http://www.tcl-lang.org/man/tcl8.6/
|
||||
http://www.tcl.tk/man/tcl8.6/
|
||||
|
||||
2a. Unix Documentation
|
||||
----------------------
|
||||
@@ -101,7 +101,7 @@ There are brief notes in the unix/README, win/README, and macosx/README about
|
||||
compiling on these different platforms. There is additional information
|
||||
about building Tcl from sources at
|
||||
|
||||
http://www.tcl-lang.org/doc/howto/compile.html
|
||||
http://www.tcl.tk/doc/howto/compile.html
|
||||
|
||||
4. Development tools
|
||||
---------------------------
|
||||
@@ -127,7 +127,7 @@ see the "Support and bug fixes" section below.
|
||||
|
||||
A Wiki-based open community site covering all aspects of Tcl/Tk is at:
|
||||
|
||||
http://wiki.tcl-lang.org/
|
||||
http://wiki.tcl.tk/
|
||||
|
||||
It is dedicated to the Tcl programming language and its extensions. A
|
||||
wealth of useful information can be found there. It contains code
|
||||
@@ -153,7 +153,7 @@ We are very interested in receiving bug reports, patches, and suggestions
|
||||
for improvements. We prefer that you send this information to us as
|
||||
tickets entered into our tracker at:
|
||||
|
||||
http://core.tcl-lang.org/tcl/reportlist
|
||||
http://core.tcl.tk/tcl/reportlist
|
||||
|
||||
We will log and follow-up on each bug, although we cannot promise a
|
||||
specific turn-around time. Enhancements may take longer and may not happen
|
||||
@@ -169,13 +169,13 @@ questions for which no one else is likely to know the answer. In addition,
|
||||
see the following Web site for links to other organizations that offer
|
||||
Tcl/Tk training:
|
||||
|
||||
http://wiki.tcl-lang.org/training
|
||||
http://wiki.tcl.tk/training
|
||||
|
||||
9. Tracking Development
|
||||
-----------------------
|
||||
|
||||
Tcl is developed in public. To keep an eye on how Tcl is changing, see
|
||||
http://core.tcl-lang.org/
|
||||
http://core.tcl.tk/
|
||||
|
||||
10. Thank You
|
||||
-------------
|
||||
|
||||
@@ -8796,101 +8796,5 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
|
||||
|
||||
--- 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
|
||||
|
||||
2018-02-11 (enhance) stop blocking conversion of object to/from class (coulter)
|
||||
|
||||
2018-02-12 (enhance) NR-enable [package require] (coulter)
|
||||
|
||||
2018-02-14 (bug)[9fd5c6] crash in object deletion, test oo-11.5 (coulter)
|
||||
|
||||
2018-02-14 (bug)[3c32a3] crash deleting object with class mixed in (coulter)
|
||||
|
||||
2018-02-15 (platform) stop using -lieee, removed from glibc-2.27 (porter)
|
||||
***POTENTIAL INCOMPATIBILITY for math programs that embed Tcl***
|
||||
|
||||
2018-02-23 (bug)[8e6a9a] bad binary [string match], test string-11.55 (porter)
|
||||
|
||||
2018-03-05 (bug)[1873ea] repair multi-thread std channel init (sebres)
|
||||
|
||||
2018-03-09 (bug)[db36fa] broken bytecode for index values (porter)
|
||||
|
||||
2018-03-13 (bug) broken compiled [string replace], test string-14.19 (porter)
|
||||
|
||||
2018-03-14 (bug) [string trim*] engine crashed on invalid UTF (sebres)
|
||||
|
||||
2018-04-17 (bug) missing trace in compiled [array set], test var-20.11 (porter)
|
||||
|
||||
2018-04-22 (bug)[46a241] crash in unset array with search, var-13.[23] (goth)
|
||||
|
||||
2018-04-30 (bug)[27b682] race made [file delete] raise "no such file" (sebres)
|
||||
|
||||
2018-06-04 (bug)[925643] 32/64 cleanup of filesystem DIR operations (sebres)
|
||||
|
||||
2018-06-18 (bug) leaks in TclSetEnv and env cache (coulter)
|
||||
|
||||
2018-06-24 (bug)[3592747] [yieldto] dying namespace, tailcall-14.1 (coulter)
|
||||
|
||||
2018-07-09 (bug)[270f78] race in [file mkdir] (sebres)
|
||||
|
||||
2018-07-12 (bug)[3f7af0] [file delete] raised "permission denied" (sebres)
|
||||
|
||||
2018-07-26 (bug)[d051b7] overflow crash in [format] (sebres)
|
||||
|
||||
2018-08-29 revised quoting of [exec] args in generated command line (sebres)
|
||||
***POTENTIAL INCOMPATIBILITY***
|
||||
|
||||
2018-09-20 HTTP Keep-Alive with pipelined requests (nash)
|
||||
=> http 2.9.0
|
||||
|
||||
2018-09-27 (new)[TIP 505] [lreplace] accepts all out of range indices (porter)
|
||||
|
||||
2018-10-04 (bug) Prevent crash from NULL keyName (nijtmans)
|
||||
=> registry 1.3.3
|
||||
|
||||
2018-10-26 (enhance) advance dde version (nijtmans)
|
||||
=> dde 1.4.1
|
||||
|
||||
2018-10-27 tzdata updated to Olson's tzdata2018g (jima)
|
||||
|
||||
2018-10-29 Update tcltest package for Travis support (fellows)
|
||||
=> tcltest 2.5.0
|
||||
|
||||
2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens)
|
||||
|
||||
2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)
|
||||
|
||||
- Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -
|
||||
|
||||
@@ -0,0 +1,36 @@
|
||||
/*
|
||||
* fixstrtod.c --
|
||||
*
|
||||
* Source code for the "fixstrtod" procedure. This procedure is
|
||||
* used in place of strtod under Solaris 2.4, in order to fix
|
||||
* a bug where the "end" pointer gets set incorrectly.
|
||||
*
|
||||
* Copyright (c) 1995 Sun Microsystems, Inc.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution
|
||||
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#undef strtod
|
||||
|
||||
/*
|
||||
* Declare strtod explicitly rather than including stdlib.h, since in
|
||||
* somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
|
||||
*/
|
||||
|
||||
extern double strtod(char *, char **);
|
||||
|
||||
double
|
||||
fixstrtod(
|
||||
char *string,
|
||||
char **endPtr)
|
||||
{
|
||||
double d;
|
||||
d = strtod(string, endPtr);
|
||||
if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
|
||||
*endPtr -= 1;
|
||||
}
|
||||
return d;
|
||||
}
|
||||
@@ -29,6 +29,7 @@ extern char * malloc(unsigned int numBytes);
|
||||
extern void qsort(void *base, int n, int size, int (*compar)(
|
||||
const void *element1, const void *element2));
|
||||
extern char * realloc(char *ptr, unsigned int numBytes);
|
||||
extern double strtod(const char *string, char **endPtr);
|
||||
extern long strtol(const char *string, char **endPtr, int base);
|
||||
extern unsigned long strtoul(const char *string, char **endPtr, int base);
|
||||
|
||||
|
||||
+252
@@ -0,0 +1,252 @@
|
||||
/*
|
||||
* strtod.c --
|
||||
*
|
||||
* Source code for the "strtod" library procedure.
|
||||
*
|
||||
* Copyright (c) 1988-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.
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#ifndef TRUE
|
||||
#define TRUE 1
|
||||
#define FALSE 0
|
||||
#endif
|
||||
#ifndef NULL
|
||||
#define NULL 0
|
||||
#endif
|
||||
|
||||
static const int maxExponent = 511; /* Largest possible base 10 exponent. Any
|
||||
* exponent larger than this will already
|
||||
* produce underflow or overflow, so there's
|
||||
* no need to worry about additional digits.
|
||||
*/
|
||||
static const double powersOf10[] = { /* Table giving binary powers of 10. Entry */
|
||||
10., /* is 10^2^i. Used to convert decimal */
|
||||
100., /* exponents into floating-point numbers. */
|
||||
1.0e4,
|
||||
1.0e8,
|
||||
1.0e16,
|
||||
1.0e32,
|
||||
1.0e64,
|
||||
1.0e128,
|
||||
1.0e256
|
||||
};
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* strtod --
|
||||
*
|
||||
* This procedure converts a floating-point number from an ASCII
|
||||
* decimal representation to internal double-precision format.
|
||||
*
|
||||
* Results:
|
||||
* The return value is the double-precision floating-point
|
||||
* representation of the characters in string. If endPtr isn't
|
||||
* NULL, then *endPtr is filled in with the address of the
|
||||
* next character after the last one that was part of the
|
||||
* floating-point number.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
double
|
||||
strtod(
|
||||
const char *string, /* A decimal ASCII floating-point number,
|
||||
* optionally preceded by white space. Must
|
||||
* have form "-I.FE-X", where I is the integer
|
||||
* part of the mantissa, F is the fractional
|
||||
* part of the mantissa, and X is the
|
||||
* exponent. Either of the signs may be "+",
|
||||
* "-", or omitted. Either I or F may be
|
||||
* omitted, or both. The decimal point isn't
|
||||
* necessary unless F is present. The "E" may
|
||||
* actually be an "e". E and X may both be
|
||||
* omitted (but not just one). */
|
||||
char **endPtr) /* If non-NULL, store terminating character's
|
||||
* address here. */
|
||||
{
|
||||
int sign, expSign = FALSE;
|
||||
double fraction, dblExp;
|
||||
const double *d;
|
||||
register const char *p;
|
||||
register int c;
|
||||
int exp = 0; /* Exponent read from "EX" field. */
|
||||
int fracExp = 0; /* Exponent that derives from the fractional
|
||||
* part. Under normal circumstatnces, it is
|
||||
* the negative of the number of digits in F.
|
||||
* However, if I is very long, the last digits
|
||||
* of I get dropped (otherwise a long I with a
|
||||
* large negative exponent could cause an
|
||||
* unnecessary overflow on I alone). In this
|
||||
* case, fracExp is incremented one for each
|
||||
* dropped digit. */
|
||||
int mantSize; /* Number of digits in mantissa. */
|
||||
int decPt; /* Number of mantissa digits BEFORE decimal
|
||||
* point. */
|
||||
const char *pExp; /* Temporarily holds location of exponent in
|
||||
* string. */
|
||||
|
||||
/*
|
||||
* Strip off leading blanks and check for a sign.
|
||||
*/
|
||||
|
||||
p = string;
|
||||
while (isspace(UCHAR(*p))) {
|
||||
p += 1;
|
||||
}
|
||||
if (*p == '-') {
|
||||
sign = TRUE;
|
||||
p += 1;
|
||||
} else {
|
||||
if (*p == '+') {
|
||||
p += 1;
|
||||
}
|
||||
sign = FALSE;
|
||||
}
|
||||
|
||||
/*
|
||||
* Count the number of digits in the mantissa (including the decimal
|
||||
* point), and also locate the decimal point.
|
||||
*/
|
||||
|
||||
decPt = -1;
|
||||
for (mantSize = 0; ; mantSize += 1)
|
||||
{
|
||||
c = *p;
|
||||
if (!isdigit(c)) {
|
||||
if ((c != '.') || (decPt >= 0)) {
|
||||
break;
|
||||
}
|
||||
decPt = mantSize;
|
||||
}
|
||||
p += 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now suck up the digits in the mantissa. Use two integers to collect 9
|
||||
* digits each (this is faster than using floating-point). If the mantissa
|
||||
* has more than 18 digits, ignore the extras, since they can't affect the
|
||||
* value anyway.
|
||||
*/
|
||||
|
||||
pExp = p;
|
||||
p -= mantSize;
|
||||
if (decPt < 0) {
|
||||
decPt = mantSize;
|
||||
} else {
|
||||
mantSize -= 1; /* One of the digits was the point. */
|
||||
}
|
||||
if (mantSize > 18) {
|
||||
fracExp = decPt - 18;
|
||||
mantSize = 18;
|
||||
} else {
|
||||
fracExp = decPt - mantSize;
|
||||
}
|
||||
if (mantSize == 0) {
|
||||
fraction = 0.0;
|
||||
p = string;
|
||||
goto done;
|
||||
} else {
|
||||
int frac1, frac2;
|
||||
|
||||
frac1 = 0;
|
||||
for ( ; mantSize > 9; mantSize -= 1) {
|
||||
c = *p;
|
||||
p += 1;
|
||||
if (c == '.') {
|
||||
c = *p;
|
||||
p += 1;
|
||||
}
|
||||
frac1 = 10*frac1 + (c - '0');
|
||||
}
|
||||
frac2 = 0;
|
||||
for (; mantSize > 0; mantSize -= 1) {
|
||||
c = *p;
|
||||
p += 1;
|
||||
if (c == '.') {
|
||||
c = *p;
|
||||
p += 1;
|
||||
}
|
||||
frac2 = 10*frac2 + (c - '0');
|
||||
}
|
||||
fraction = (1.0e9 * frac1) + frac2;
|
||||
}
|
||||
|
||||
/*
|
||||
* Skim off the exponent.
|
||||
*/
|
||||
|
||||
p = pExp;
|
||||
if ((*p == 'E') || (*p == 'e')) {
|
||||
p += 1;
|
||||
if (*p == '-') {
|
||||
expSign = TRUE;
|
||||
p += 1;
|
||||
} else {
|
||||
if (*p == '+') {
|
||||
p += 1;
|
||||
}
|
||||
expSign = FALSE;
|
||||
}
|
||||
if (!isdigit(UCHAR(*p))) {
|
||||
p = pExp;
|
||||
goto done;
|
||||
}
|
||||
while (isdigit(UCHAR(*p))) {
|
||||
exp = exp * 10 + (*p - '0');
|
||||
p += 1;
|
||||
}
|
||||
}
|
||||
if (expSign) {
|
||||
exp = fracExp - exp;
|
||||
} else {
|
||||
exp = fracExp + exp;
|
||||
}
|
||||
|
||||
/*
|
||||
* Generate a floating-point number that represents the exponent. Do this
|
||||
* by processing the exponent one bit at a time to combine many powers of
|
||||
* 2 of 10. Then combine the exponent with the fraction.
|
||||
*/
|
||||
|
||||
if (exp < 0) {
|
||||
expSign = TRUE;
|
||||
exp = -exp;
|
||||
} else {
|
||||
expSign = FALSE;
|
||||
}
|
||||
if (exp > maxExponent) {
|
||||
exp = maxExponent;
|
||||
errno = ERANGE;
|
||||
}
|
||||
dblExp = 1.0;
|
||||
for (d = powersOf10; exp != 0; exp >>= 1, ++d) {
|
||||
if (exp & 01) {
|
||||
dblExp *= *d;
|
||||
}
|
||||
}
|
||||
if (expSign) {
|
||||
fraction /= dblExp;
|
||||
} else {
|
||||
fraction *= dblExp;
|
||||
}
|
||||
|
||||
done:
|
||||
if (endPtr != NULL) {
|
||||
*endPtr = (char *) p;
|
||||
}
|
||||
|
||||
if (sign) {
|
||||
return -fraction;
|
||||
}
|
||||
return fraction;
|
||||
}
|
||||
+1
-1
@@ -53,7 +53,7 @@ strtol(
|
||||
*/
|
||||
|
||||
p = string;
|
||||
while (TclIsSpaceProc(*p)) {
|
||||
while (isspace(UCHAR(*p))) {
|
||||
p += 1;
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -74,7 +74,7 @@ strtoul(
|
||||
*/
|
||||
|
||||
p = string;
|
||||
while (TclIsSpaceProc(*p)) {
|
||||
while (isspace(UCHAR(*p))) {
|
||||
p += 1;
|
||||
}
|
||||
if (*p == '-') {
|
||||
|
||||
@@ -97,7 +97,7 @@ void change_file_date(filename,dosdate,tmu_date)
|
||||
SetFileTime(hFile,&ftm,&ftLastAcc,&ftm);
|
||||
CloseHandle(hFile);
|
||||
#else
|
||||
#if defined(unix) || defined(__APPLE__)
|
||||
#ifdef unix || __APPLE__
|
||||
struct utimbuf ut;
|
||||
struct tm newdate;
|
||||
newdate.tm_sec = tmu_date.tm_sec;
|
||||
|
||||
@@ -94,7 +94,7 @@ uLong filetime(f, tmzip, dt)
|
||||
return ret;
|
||||
}
|
||||
#else
|
||||
#if defined(unix) || defined(__APPLE__)
|
||||
#ifdef unix || __APPLE__
|
||||
uLong filetime(f, tmzip, dt)
|
||||
char *f; /* name of file to get info on */
|
||||
tm_zip *tmzip; /* return value: access, modific. and creation times */
|
||||
|
||||
@@ -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
|
||||
|
||||
+4
-4
@@ -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
|
||||
|
||||
@@ -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.
|
||||
|
||||
+3
-3
@@ -3,7 +3,7 @@
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
'\"
|
||||
.TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures"
|
||||
.so man.macros
|
||||
.BS
|
||||
@@ -103,8 +103,8 @@ the argument's value. The following values are acceptable values for
|
||||
\fBTCL_ARGV_CONSTANT\fR
|
||||
.
|
||||
The argument does not take any following value argument. If this argument is
|
||||
present, the \fIsrcPtr\fR field (casted to \fIint\fR) is copied to the variable
|
||||
pointed to by the \fIdstPtr\fR field. The \fIclientData\fR field is ignored.
|
||||
present, the int pointed to by the \fIsrcPtr\fR field is copied to the
|
||||
\fIdstPtr\fR field. The \fIclientData\fR field is ignored.
|
||||
.TP
|
||||
\fBTCL_ARGV_END\fR
|
||||
.
|
||||
|
||||
+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
|
||||
|
||||
@@ -53,11 +53,14 @@ The Tcl_UniChar to be examined.
|
||||
|
||||
.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
|
||||
|
||||
@@ -47,6 +47,13 @@ been the return value from a previous invocation of
|
||||
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
|
||||
is no variable by that name or if it is a scalar variable.
|
||||
.TP
|
||||
\fBarray for {\fIkeyVariable ?valueVariable?\fB} \fIarrayName body\fR
|
||||
The first argument is a one or two element list of variable names for the
|
||||
key and value of each entry in the array. The second argument is the
|
||||
array name to iterate over. The third argument is the body to execute
|
||||
for each key and value returned.
|
||||
The ordering of the returned keys is undefined.
|
||||
.TP
|
||||
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
|
||||
Returns a list containing pairs of elements. The first
|
||||
element in each pair is the name of an element in \fIarrayName\fR
|
||||
|
||||
-13
@@ -453,19 +453,6 @@ If this situation occurs, the first occurrence of the time is chosen.
|
||||
(For this reason, it is wise to have the input string contain the
|
||||
time zone when converting local times. This caveat does not apply to
|
||||
UTC times.)
|
||||
.PP
|
||||
If the interpretation of the groups yields an impossible time because
|
||||
a field is out of range, enough of that field's unit will be added to
|
||||
or subtracted from the time to bring it in range. Thus, if attempting to
|
||||
scan or format day 0 of the month, one day will be subtracted from day
|
||||
1 of the month, yielding the last day of the previous month.
|
||||
.PP
|
||||
If the interpretation of the groups yields an impossible time because
|
||||
a Daylight Saving Time change skips over that time, or an ambiguous
|
||||
time because a Daylight Saving Time change skips back so that the clock
|
||||
observes the given time twice, and no time zone specifier (\fB%z\fR
|
||||
or \fB%Z\fR) is present in the format, the time is interpreted as
|
||||
if the clock had not changed.
|
||||
.SH "FORMAT GROUPS"
|
||||
.PP
|
||||
The following format groups are recognized by the \fBclock scan\fR and
|
||||
|
||||
+1
-1
@@ -50,7 +50,7 @@ being constructed. Within the constructor, the \fBnext\fR command should be
|
||||
used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
|
||||
string, the constructor will be deleted.
|
||||
.TP
|
||||
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
|
||||
\fBdeletemethod\fI name\fR ?\fIname ...\fR
|
||||
.
|
||||
This deletes each of the methods called \fIname\fR from a class. The methods
|
||||
must have previously existed in that class. Does not affect the superclasses
|
||||
|
||||
-17
@@ -217,19 +217,6 @@ information is instead sent to the console, if one is present, or is
|
||||
discarded.
|
||||
.RS
|
||||
.PP
|
||||
Note that the current escape resp. quoting of arguments for windows works only
|
||||
with executables using CommandLineToArgv, CRT-library or similar, as well as
|
||||
with the windows batch files (excepting the newline, see below).
|
||||
Although it is the common escape algorithm, but, in fact, the way how the
|
||||
executable parses the command-line (resp. splits it into single arguments)
|
||||
is decisive.
|
||||
.PP
|
||||
Unfortunately, there is currently no way to supply newline character within
|
||||
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
|
||||
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
|
||||
(also the argument chain) on the first newline character.
|
||||
But it works properly with an executable (using CommandLineToArgv, etc).
|
||||
.PP
|
||||
The Tk console text widget does not provide real standard IO capabilities.
|
||||
Under Tk, when redirecting from standard input, all applications will see an
|
||||
immediate end-of-file; information redirected to standard output or standard
|
||||
@@ -422,10 +409,6 @@ that sometimes pop up:
|
||||
With the file \fIcmp.bat\fR looking something like:
|
||||
.PP
|
||||
.CS
|
||||
@gcc %*
|
||||
.CE
|
||||
or like another variant using single parameters:
|
||||
.CS
|
||||
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
|
||||
.CE
|
||||
.SS "WORKING WITH COMMAND BUILT-INS"
|
||||
|
||||
+2
-2
@@ -83,7 +83,7 @@ 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
|
||||
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.
|
||||
@@ -169,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.
|
||||
|
||||
+9
-177
@@ -6,14 +6,14 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH "http" n 2.9 http "Tcl Bundled Packages"
|
||||
.TH "http" n 2.7 http "Tcl Bundled Packages"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.SH SYNOPSIS
|
||||
\fBpackage require http ?2.8?\fR
|
||||
\fBpackage require http ?2.7?\fR
|
||||
.\" See Also -useragent option documentation in body!
|
||||
.sp
|
||||
\fB::http::config ?\fI\-option value\fR ...?
|
||||
@@ -22,8 +22,6 @@ http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.sp
|
||||
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
|
||||
.sp
|
||||
\fB::http::quoteString\fR \fIvalue\fR
|
||||
.sp
|
||||
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
|
||||
.sp
|
||||
\fB::http::wait \fItoken\fR
|
||||
@@ -46,14 +44,12 @@ http \- Client-side implementation of the HTTP/1.1 protocol
|
||||
.sp
|
||||
\fB::http::register \fIproto port command\fR
|
||||
.sp
|
||||
\fB::http::registerError \fIport\fR ?\fImessage\fR?
|
||||
.sp
|
||||
\fB::http::unregister \fIproto\fR
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBhttp\fR package provides the client side of the HTTP/1.1
|
||||
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
|
||||
protocol, as defined in RFC 2616.
|
||||
The package implements the GET, POST, and HEAD operations
|
||||
of HTTP/1.1. It allows configuration of a proxy host to get through
|
||||
firewalls. The package is compatible with the \fBSafesock\fR security
|
||||
@@ -99,19 +95,6 @@ comma-separated list of mime type patterns that you are
|
||||
willing to receive. For example,
|
||||
.QW "image/gif, image/jpeg, text/*" .
|
||||
.TP
|
||||
\fB\-pipeline\fR \fIboolean\fR
|
||||
.
|
||||
Specifies whether HTTP/1.1 transactions on a persistent socket will be
|
||||
pipelined. See the \fBPERSISTENT SOCKETS\fR section for details. The default
|
||||
is 1.
|
||||
.TP
|
||||
\fB\-postfresh\fR \fIboolean\fR
|
||||
.
|
||||
Specifies whether requests that use the \fBPOST\fR method will always use a
|
||||
fresh socket, overriding the \fB-keepalive\fR option of
|
||||
command \fBhttp::geturl\fR. See the \fBPERSISTENT SOCKETS\fR section for details.
|
||||
The default is 0.
|
||||
.TP
|
||||
\fB\-proxyhost\fR \fIhostname\fR
|
||||
.
|
||||
The name of the proxy host, if any. If this value is the
|
||||
@@ -133,47 +116,20 @@ an empty list. The default filter returns the values of the
|
||||
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
|
||||
non-empty.
|
||||
.TP
|
||||
\fB\-repost\fR \fIboolean\fR
|
||||
.
|
||||
Specifies what to do if a POST request over a persistent connection fails
|
||||
because the server has half-closed the connection. If boolean \fBtrue\fR, the
|
||||
request
|
||||
will be automatically retried; if boolean \fBfalse\fR it will not, and the
|
||||
application
|
||||
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
|
||||
retrying the POST. The value \fBtrue\fR should be used only under certain
|
||||
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
|
||||
default is 0.
|
||||
.TP
|
||||
\fB\-urlencoding\fR \fIencoding\fR
|
||||
.
|
||||
The \fIencoding\fR used for creating the x-url-encoded URLs with
|
||||
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
|
||||
The default is \fButf-8\fR, as specified by RFC
|
||||
\fB::http::formatQuery\fR. The default is \fButf-8\fR, as specified by RFC
|
||||
2718. Prior to http 2.5 this was unspecified, and that behavior can be
|
||||
returned by specifying the empty string (\fB{}\fR), although
|
||||
\fIiso8859-1\fR is recommended to restore similar behavior but without the
|
||||
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
|
||||
throwing an error processing non-latin-1 characters.
|
||||
\fB::http::formatQuery\fR throwing an error processing non-latin-1
|
||||
characters.
|
||||
.TP
|
||||
\fB\-useragent\fR \fIstring\fR
|
||||
.
|
||||
The value of the User-Agent header in the HTTP request. In an unsafe
|
||||
interpreter, the default value depends upon the operating system, and
|
||||
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
|
||||
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
|
||||
A safe interpreter cannot determine its operating system, and so the default
|
||||
in a safe interpreter is to use a Windows 10 value with the current version
|
||||
numbers of \fBhttp\fR and \fBTcl\fR.
|
||||
.TP
|
||||
\fB\-zip\fR \fIboolean\fR
|
||||
.
|
||||
If the value is boolean \fBtrue\fR, then by default requests will send a header
|
||||
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
|
||||
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
|
||||
In either case the default can be overridden for an individual request by
|
||||
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
|
||||
of \fBhttp::geturl\fR. The default is 1.
|
||||
The value of the User-Agent header in the HTTP request. The default is
|
||||
.QW "\fBTcl http client package 2.7\fR" .
|
||||
.RE
|
||||
.TP
|
||||
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
|
||||
@@ -271,7 +227,7 @@ Pragma: no-cache
|
||||
.TP
|
||||
\fB\-keepalive\fR \fIboolean\fR
|
||||
.
|
||||
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
|
||||
If true, attempt to keep the connection open for servicing
|
||||
multiple requests. Default is 0.
|
||||
.TP
|
||||
\fB\-method\fR \fItype\fR
|
||||
@@ -378,11 +334,6 @@ encodes the keys and values, and generates one string that has the
|
||||
proper & and = separators. The result is suitable for the
|
||||
\fB\-query\fR value passed to \fB::http::geturl\fR.
|
||||
.TP
|
||||
\fB::http::quoteString\fR \fIvalue\fR
|
||||
.
|
||||
This procedure does x-url-encoding of string. It takes a single argument and
|
||||
encodes it.
|
||||
.TP
|
||||
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
|
||||
.
|
||||
This command resets the HTTP transaction identified by \fItoken\fR, if any.
|
||||
@@ -464,17 +415,6 @@ set token [::http::geturl https://my.secure.site/]
|
||||
.CE
|
||||
.RE
|
||||
.TP
|
||||
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
|
||||
.
|
||||
This procedure allows a registered protocol handler to deliver an error
|
||||
message for use by \fBhttp\fR. Calling this command does not raise an
|
||||
error. The command is useful when a registered protocol detects an problem
|
||||
(for example, an invalid TLS certificate) that will cause an error to
|
||||
propagate to \fBhttp\fR. The command allows \fBhttp\fR to provide a
|
||||
precise error message rather than a general one. The command returns the
|
||||
value provided by the last call with argument \fImessage\fR, or the empty
|
||||
string if no such call has been made.
|
||||
.TP
|
||||
\fB::http::unregister\fR \fIproto\fR
|
||||
.
|
||||
This procedure unregisters a protocol handler that was previously
|
||||
@@ -564,14 +504,6 @@ The following elements of
|
||||
the array are supported:
|
||||
.RS
|
||||
.TP
|
||||
\fBbinary\fR
|
||||
.
|
||||
This is boolean \fBtrue\fR if (after decoding any compression specified
|
||||
by the
|
||||
.QW "Content-Encoding"
|
||||
response header) the HTTP response is binary. It is boolean \fBfalse\fR
|
||||
if the HTTP response is text.
|
||||
.TP
|
||||
\fBbody\fR
|
||||
.
|
||||
The contents of the URL. This will be empty if the \fB\-channel\fR
|
||||
@@ -670,106 +602,6 @@ A copy of the \fBContent-Type\fR meta-data value.
|
||||
.
|
||||
The requested URL.
|
||||
.RE
|
||||
.SH "PERSISTENT CONNECTIONS"
|
||||
.PP
|
||||
.SS "BASICS"
|
||||
.PP
|
||||
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
|
||||
.PP
|
||||
A persistent connection allows multiple HTTP/1.1 transactions to be
|
||||
carried over the same TCP connection. Pipelining allows a
|
||||
client to make multiple requests over a persistent connection without
|
||||
waiting for each response. The server sends responses in the same order
|
||||
that the requests were received.
|
||||
.PP
|
||||
If a POST request fails to complete, typically user confirmation is
|
||||
needed before sending the request again. The user may wish to verify
|
||||
whether the server was modified by the failed POST request, before
|
||||
sending the same request again.
|
||||
.PP
|
||||
A HTTP request will use a persistent socket if the call to
|
||||
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
|
||||
pipelining where permitted if the \fBhttp::config\fR option
|
||||
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
|
||||
.PP
|
||||
The http package maintains no more than one persistent connection to each
|
||||
server (i.e. each value of
|
||||
.QW "domain:port" ).
|
||||
If \fBhttp::geturl\fR is called to make a request over a persistent
|
||||
connection while the connection is busy with another request, the new
|
||||
request will be held in a queue until the connection is free.
|
||||
.PP
|
||||
The http package does not support HTTP/1.0 persistent connections
|
||||
controlled by the \fBKeep-Alive\fR header.
|
||||
.SS "SPECIAL CASES"
|
||||
.PP
|
||||
This subsection discusses issues related to closure of the
|
||||
persistent connection by the server, automatic retry of failed requests,
|
||||
the special treatment necessary for POST requests, and the options for
|
||||
dealing with these cases.
|
||||
.PP
|
||||
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
|
||||
requests that use the POST method. If a POST uses a persistent
|
||||
connection and is not the first request on that connection,
|
||||
\fBhttp::geturl\fR waits until it has received the response for the previous
|
||||
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
|
||||
uses a new connection for each POST.
|
||||
.PP
|
||||
If the server is processing a number of pipelined requests, and sends a
|
||||
response header
|
||||
.QW "\fBConnection: close\fR"
|
||||
with one of the responses (other than the last), then subsequent responses
|
||||
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
|
||||
over a new connection.
|
||||
.PP
|
||||
A difficulty arises when a HTTP client sends a request over a persistent
|
||||
connection that has been idle for a while. The HTTP server may
|
||||
half-close an apparently idle connection while the client is sending a
|
||||
request, but before the request arrives at the server: in this case (an
|
||||
.QW "asynchronous close event" )
|
||||
the request will fail. The difficulty arises because the client cannot
|
||||
be certain whether the POST modified the state of the server. For HEAD or
|
||||
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
|
||||
the failed request. However, if the request was a POST, RFC 7230 forbids
|
||||
automatic retry by default, suggesting either user confirmation, or
|
||||
confirmation by user-agent software that has semantic understanding of
|
||||
the application. The \fBhttp::config\fR option \fB-repost\fR allows for
|
||||
either possibility.
|
||||
.PP
|
||||
Asynchronous close events can occur only in a short interval of time. The
|
||||
\fBhttp\fR package monitors each persistent connection for closure by the
|
||||
server. Upon detection, the connection is also closed at the client end,
|
||||
and subsequent requests will use a fresh connection.
|
||||
.PP
|
||||
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
|
||||
then it will both try to use an existing persistent connection
|
||||
(if one is available), and it will send the server a
|
||||
.QW "\fBConnection: keep-alive\fR"
|
||||
request header asking to keep the connection open for future requests.
|
||||
.PP
|
||||
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
|
||||
\fB-repost\fR relate to persistent connections.
|
||||
.PP
|
||||
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
|
||||
made
|
||||
over a persistent connection. POST requests will not be pipelined - if the
|
||||
POST is not the first transaction on the connection, its request will not
|
||||
be sent until the previous response has finished. GET and HEAD requests
|
||||
made after a POST will not be sent until the POST response has been
|
||||
delivered, and will not be sent if the POST fails.
|
||||
.PP
|
||||
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
|
||||
\fB-keepalive\fR, and always open a fresh connection for a POST request.
|
||||
.PP
|
||||
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
|
||||
that fails because it uses a persistent connection that the server has
|
||||
half-closed (an
|
||||
.QW "asynchronous close event" ).
|
||||
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
|
||||
\fIThe -repost option should be used only if the application understands
|
||||
that the retry is appropriate\fR - specifically, the application must know
|
||||
that if the failed POST successfully modified the state of the server, a repeat POST
|
||||
would have no adverse effect.
|
||||
.SH EXAMPLE
|
||||
.PP
|
||||
This example creates a procedure to copy a URL to a file while printing a
|
||||
|
||||
+10
-30
@@ -17,7 +17,7 @@ lreplace \- Replace elements in a list with new elements
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fBlreplace\fR returns a new list formed by replacing zero or more elements of
|
||||
\fBlreplace\fR returns a new list formed by replacing one or more elements of
|
||||
\fIlist\fR with the \fIelement\fR arguments.
|
||||
\fIfirst\fR and \fIlast\fR are index values specifying the first and
|
||||
last elements of the range to replace.
|
||||
@@ -27,26 +27,23 @@ supporting simple index arithmetic and indices relative to the
|
||||
end of the list.
|
||||
0 refers to the first element of the
|
||||
list, and \fBend\fR refers to the last element of the list.
|
||||
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
|
||||
.PP
|
||||
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
|
||||
to refer to before the first element of the list. This allows \fBlreplace\fR
|
||||
to prepend elements to \fIlist\fR.
|
||||
.VS TIP505
|
||||
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
|
||||
index of the last element of the list, it is treated as if it is an
|
||||
index one greater than the last element. This allows \fBlreplace\fR to
|
||||
append elements to \fIlist\fR.
|
||||
.VE TIP505
|
||||
If \fIfirst\fR is less than zero, it is considered to refer to before the
|
||||
first element of the list. For non-empty lists, the element indicated
|
||||
by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
|
||||
start of the list.
|
||||
.PP
|
||||
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
|
||||
will be inserted into the list before the element specified by \fIfirst\fR
|
||||
will be inserted into the list before the point specified by \fIfirst\fR
|
||||
with no elements being deleted.
|
||||
.PP
|
||||
The \fIelement\fR arguments specify zero or more new elements to
|
||||
The \fIelement\fR arguments specify zero or more new arguments to
|
||||
be added to the list in place of those that were deleted.
|
||||
Each \fIelement\fR argument will become a separate element of
|
||||
the list. If no \fIelement\fR arguments are specified, then the elements
|
||||
between \fIfirst\fR and \fIlast\fR are simply deleted.
|
||||
between \fIfirst\fR and \fIlast\fR are simply deleted. If \fIlist\fR
|
||||
is empty, any \fIelement\fR arguments are added to the end of the list.
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
Replacing an element of a list with another:
|
||||
@@ -81,26 +78,9 @@ proc lremove {listVariable value} {
|
||||
set var [\fBlreplace\fR $var $idx $idx]
|
||||
}
|
||||
.CE
|
||||
.PP
|
||||
.VS TIP505
|
||||
Appending elements to the list; note that \fBend+2\fR will initially
|
||||
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
|
||||
than the index of the final item so they behave identically:
|
||||
.PP
|
||||
.CS
|
||||
% set var {a b c d e}
|
||||
a b c d e
|
||||
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
|
||||
a b c d e f g h i
|
||||
.CE
|
||||
.VE TIP505
|
||||
.SH "SEE ALSO"
|
||||
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
|
||||
lset(n), lrange(n), lsort(n),
|
||||
string(n)
|
||||
.SH KEYWORDS
|
||||
element, list, replace
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
.\" End:
|
||||
|
||||
+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
|
||||
|
||||
+2
-12
@@ -8,7 +8,7 @@
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages"
|
||||
.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
@@ -16,7 +16,7 @@
|
||||
tcltest \- Test harness support code and utilities
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fBpackage require tcltest\fR ?\fB2.5\fR?
|
||||
\fBpackage require tcltest\fR ?\fB2.3\fR?
|
||||
|
||||
\fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR?
|
||||
\fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR
|
||||
@@ -454,7 +454,6 @@ The valid options for \fBtest\fR are summarized:
|
||||
?\fB\-output \fIexpectedOutput\fR?
|
||||
?\fB\-errorOutput \fIexpectedError\fR?
|
||||
?\fB\-returnCodes \fIcodeList\fR?
|
||||
?\fB\-errorCode \fIexpectedErrorCode\fR?
|
||||
?\fB\-match \fImode\fR?
|
||||
.CE
|
||||
.PP
|
||||
@@ -578,15 +577,6 @@ return codes known to \fBreturn\fR, in both numeric and symbolic
|
||||
form, including extended return codes, are acceptable elements in
|
||||
the \fIexpectedCodeList\fR. Default value is
|
||||
.QW "\fBok return\fR" .
|
||||
.TP
|
||||
\fB\-errorCode \fIexpectedErrorCode\fR
|
||||
.
|
||||
The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR,
|
||||
a glob pattern that should match the error code reported from evaluation of the
|
||||
\fB\-body\fR script. If evaluation of the \fB\-body\fR script returns
|
||||
a code not matching \fIexpectedErrorCode\fR, the test fails. Default value is
|
||||
.QW "\fB*\fR" .
|
||||
If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR.
|
||||
.PP
|
||||
To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR,
|
||||
and \fB\-cleanup\fR scripts. The return code of the \fB\-body\fR script and
|
||||
|
||||
+268
-279
@@ -137,8 +137,8 @@ static const crange alphaRangeTable[] = {
|
||||
{0x41, 0x5a}, {0x61, 0x7a}, {0xc0, 0xd6}, {0xd8, 0xf6},
|
||||
{0xf8, 0x2c1}, {0x2c6, 0x2d1}, {0x2e0, 0x2e4}, {0x370, 0x374},
|
||||
{0x37a, 0x37d}, {0x388, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x3f5},
|
||||
{0x3f7, 0x481}, {0x48a, 0x52f}, {0x531, 0x556}, {0x560, 0x588},
|
||||
{0x5d0, 0x5ea}, {0x5ef, 0x5f2}, {0x620, 0x64a}, {0x671, 0x6d3},
|
||||
{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},
|
||||
@@ -153,54 +153,57 @@ static const crange alphaRangeTable[] = {
|
||||
{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}, {0xe86, 0xe8a},
|
||||
{0xe8c, 0xea3}, {0xea7, 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, 0x1878},
|
||||
{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}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf},
|
||||
{0x1ce9, 0x1cec}, {0x1cee, 0x1cf3}, {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, 0x312f}, {0x3131, 0x318e}, {0x31a0, 0x31ba},
|
||||
{0x31f0, 0x31ff}, {0x3400, 0x4db5}, {0x4e00, 0x9fef}, {0xa000, 0xa48c},
|
||||
{0xa4d0, 0xa4fd}, {0xa500, 0xa60c}, {0xa610, 0xa61f}, {0xa640, 0xa66e},
|
||||
{0xa67f, 0xa69d}, {0xa6a0, 0xa6e5}, {0xa717, 0xa71f}, {0xa722, 0xa788},
|
||||
{0xa78b, 0xa7bf}, {0xa7c2, 0xa7c6}, {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, 0xab67},
|
||||
{0xab70, 0xabe2}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
|
||||
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
|
||||
{0xfb1f, 0xfb28}, {0xfb2a, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbb1},
|
||||
{0xfbd3, 0xfd3d}, {0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfb},
|
||||
{0xfe70, 0xfe74}, {0xfe76, 0xfefc}, {0xff21, 0xff3a}, {0xff41, 0xff5a},
|
||||
{0xff66, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
|
||||
{0xffda, 0xffdc}
|
||||
#if CHRBITS > 16
|
||||
{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}
|
||||
#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},
|
||||
@@ -209,26 +212,23 @@ static const crange alphaRangeTable[] = {
|
||||
{0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
|
||||
{0x1080a, 0x10835}, {0x1083f, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089e},
|
||||
{0x108e0, 0x108f2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109b7},
|
||||
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a60, 0x10a7c},
|
||||
{0x10a10, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a60, 0x10a7c},
|
||||
{0x10a80, 0x10a9c}, {0x10ac0, 0x10ac7}, {0x10ac9, 0x10ae4}, {0x10b00, 0x10b35},
|
||||
{0x10b40, 0x10b55}, {0x10b60, 0x10b72}, {0x10b80, 0x10b91}, {0x10c00, 0x10c48},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10d00, 0x10d23}, {0x10f00, 0x10f1c},
|
||||
{0x10f30, 0x10f45}, {0x10fe0, 0x10ff6}, {0x11003, 0x11037}, {0x11083, 0x110af},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x11003, 0x11037}, {0x11083, 0x110af},
|
||||
{0x110d0, 0x110e8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111b2},
|
||||
{0x111c1, 0x111c4}, {0x11200, 0x11211}, {0x11213, 0x1122b}, {0x11280, 0x11286},
|
||||
{0x1128a, 0x1128d}, {0x1128f, 0x1129d}, {0x1129f, 0x112a8}, {0x112b0, 0x112de},
|
||||
{0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330}, {0x11335, 0x11339},
|
||||
{0x1135d, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144a}, {0x11480, 0x114af},
|
||||
{0x11580, 0x115ae}, {0x115d8, 0x115db}, {0x11600, 0x1162f}, {0x11680, 0x116aa},
|
||||
{0x11700, 0x1171a}, {0x11800, 0x1182b}, {0x118a0, 0x118df}, {0x119a0, 0x119a7},
|
||||
{0x119aa, 0x119d0}, {0x11a0b, 0x11a32}, {0x11a5c, 0x11a89}, {0x11ac0, 0x11af8},
|
||||
{0x11c00, 0x11c08}, {0x11c0a, 0x11c2e}, {0x11c72, 0x11c8f}, {0x11d00, 0x11d06},
|
||||
{0x11d0b, 0x11d30}, {0x11d60, 0x11d65}, {0x11d6a, 0x11d89}, {0x11ee0, 0x11ef2},
|
||||
{0x12000, 0x12399}, {0x12480, 0x12543}, {0x13000, 0x1342e}, {0x14400, 0x14646},
|
||||
{0x16800, 0x16a38}, {0x16a40, 0x16a5e}, {0x16ad0, 0x16aed}, {0x16b00, 0x16b2f},
|
||||
{0x16b40, 0x16b43}, {0x16b63, 0x16b77}, {0x16b7d, 0x16b8f}, {0x16e40, 0x16e7f},
|
||||
{0x16f00, 0x16f4a}, {0x16f93, 0x16f9f}, {0x17000, 0x187f7}, {0x18800, 0x18af2},
|
||||
{0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb},
|
||||
{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},
|
||||
@@ -236,13 +236,12 @@ static const crange alphaRangeTable[] = {
|
||||
{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}, {0x1e100, 0x1e12c}, {0x1e137, 0x1e13d}, {0x1e2c0, 0x1e2eb},
|
||||
{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}
|
||||
{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}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -259,24 +258,23 @@ static const chr alphaCharTable[] = {
|
||||
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,
|
||||
0xea5, 0xeb2, 0xeb3, 0xebd, 0xec6, 0xf00, 0x103f, 0x1061, 0x1065,
|
||||
0x1066, 0x108e, 0x10c7, 0x10cd, 0x1258, 0x12c0, 0x17d7, 0x17dc, 0x18aa,
|
||||
0x1aa7, 0x1bae, 0x1baf, 0x1cf5, 0x1cf6, 0x1cfa, 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, 0xa8fe,
|
||||
0xa9cf, 0xaa7a, 0xaab1, 0xaab5, 0xaab6, 0xaac0, 0xaac2, 0xfb1d, 0xfb3e,
|
||||
0xfb40, 0xfb41, 0xfb43, 0xfb44
|
||||
#if CHRBITS > 16
|
||||
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, 0x10f27, 0x11144, 0x11176, 0x111da, 0x111dc, 0x11288, 0x1130f,
|
||||
0x11310, 0x11332, 0x11333, 0x1133d, 0x11350, 0x1145f, 0x114c4, 0x114c5, 0x114c7,
|
||||
0x11644, 0x116b8, 0x118ff, 0x119e1, 0x119e3, 0x11a00, 0x11a3a, 0x11a50, 0x11a9d,
|
||||
0x11c40, 0x11d08, 0x11d09, 0x11d46, 0x11d67, 0x11d68, 0x11d98, 0x16f50, 0x16fe0,
|
||||
0x16fe1, 0x16fe3, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546,
|
||||
0x1e14e, 0x1e94b, 0x1ee21, 0x1ee22, 0x1ee24, 0x1ee27, 0x1ee39, 0x1ee3b, 0x1ee42,
|
||||
0x1ee47, 0x1ee49, 0x1ee4b, 0x1ee51, 0x1ee52, 0x1ee54, 0x1ee57, 0x1ee59, 0x1ee5b,
|
||||
0x1ee5d, 0x1ee5f, 0x1ee61, 0x1ee62, 0x1ee64, 0x1ee7e
|
||||
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
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -290,9 +288,9 @@ static const crange controlRangeTable[] = {
|
||||
{0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x605}, {0x200b, 0x200f},
|
||||
{0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff},
|
||||
{0xfff9, 0xfffb}
|
||||
#if CHRBITS > 16
|
||||
,{0x13430, 0x13438}, {0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f},
|
||||
{0xf0000, 0xffffd}, {0x100000, 0x10fffd}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x1bca0, 0x1bca3}, {0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd},
|
||||
{0x100000, 0x10fffd}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -300,8 +298,8 @@ static const crange controlRangeTable[] = {
|
||||
|
||||
static const chr controlCharTable[] = {
|
||||
0xad, 0x61c, 0x6dd, 0x70f, 0x8e2, 0x180e, 0xfeff
|
||||
#if CHRBITS > 16
|
||||
,0x110bd, 0x110cd, 0xe0001
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x110bd, 0xe0001
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -322,13 +320,12 @@ static const crange digitRangeTable[] = {
|
||||
{0x1c50, 0x1c59}, {0xa620, 0xa629}, {0xa8d0, 0xa8d9}, {0xa900, 0xa909},
|
||||
{0xa9d0, 0xa9d9}, {0xa9f0, 0xa9f9}, {0xaa50, 0xaa59}, {0xabf0, 0xabf9},
|
||||
{0xff10, 0xff19}
|
||||
#if CHRBITS > 16
|
||||
,{0x104a0, 0x104a9}, {0x10d30, 0x10d39}, {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}, {0x11da0, 0x11da9},
|
||||
{0x16a60, 0x16a69}, {0x16b50, 0x16b59}, {0x1d7ce, 0x1d7ff}, {0x1e140, 0x1e149},
|
||||
{0x1e2f0, 0x1e2f9}, {0x1e950, 0x1e959}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{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}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -351,20 +348,19 @@ 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, 0x2e4f},
|
||||
{0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e49},
|
||||
{0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f},
|
||||
{0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd},
|
||||
{0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61},
|
||||
{0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d},
|
||||
{0xff5f, 0xff65}
|
||||
#if CHRBITS > 16
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10af0, 0x10af6}, {0x10b39, 0x10b3f},
|
||||
{0x10b99, 0x10b9c}, {0x10f55, 0x10f59}, {0x11047, 0x1104d}, {0x110be, 0x110c1},
|
||||
{0x11140, 0x11143}, {0x111c5, 0x111c8}, {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}, {0x16e97, 0x16e9a},
|
||||
{0x1da87, 0x1da8b}
|
||||
{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}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -375,20 +371,18 @@ 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, 0xa76, 0xaf0, 0xc77, 0xc84, 0xdf4, 0xe4f, 0xe5a, 0xe5b,
|
||||
0xf14, 0xf85, 0xfd9, 0xfda, 0x10fb, 0x1400, 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 CHRBITS > 16
|
||||
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
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1039f, 0x103d0, 0x1056f, 0x10857, 0x1091f, 0x1093f, 0x10a7f, 0x110bb, 0x110bc,
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x1183b,
|
||||
0x119e2, 0x11c70, 0x11c71, 0x11ef7, 0x11ef8, 0x11fff, 0x16a6e, 0x16a6f, 0x16af5,
|
||||
0x16b44, 0x16fe2, 0x1bc9f, 0x1e95e, 0x1e95f
|
||||
0x11174, 0x11175, 0x111cd, 0x111db, 0x112a9, 0x1145b, 0x1145d, 0x114c6, 0x11c70,
|
||||
0x11c71, 0x16a6e, 0x16a6f, 0x16af5, 0x16b44, 0x1bc9f, 0x1e95e, 0x1e95f
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -419,25 +413,25 @@ static const crange lowerRangeTable[] = {
|
||||
{0x61, 0x7a}, {0xdf, 0xf6}, {0xf8, 0xff}, {0x17e, 0x180},
|
||||
{0x199, 0x19b}, {0x1bd, 0x1bf}, {0x233, 0x239}, {0x24f, 0x293},
|
||||
{0x295, 0x2af}, {0x37b, 0x37d}, {0x3ac, 0x3ce}, {0x3d5, 0x3d7},
|
||||
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x560, 0x588}, {0x10d0, 0x10fa},
|
||||
{0x10fd, 0x10ff}, {0x13f8, 0x13fd}, {0x1c80, 0x1c88}, {0x1d00, 0x1d2b},
|
||||
{0x1d6b, 0x1d77}, {0x1d79, 0x1d9a}, {0x1e95, 0x1e9d}, {0x1eff, 0x1f07},
|
||||
{0x1f10, 0x1f15}, {0x1f20, 0x1f27}, {0x1f30, 0x1f37}, {0x1f40, 0x1f45},
|
||||
{0x1f50, 0x1f57}, {0x1f60, 0x1f67}, {0x1f70, 0x1f7d}, {0x1f80, 0x1f87},
|
||||
{0x1f90, 0x1f97}, {0x1fa0, 0x1fa7}, {0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4},
|
||||
{0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7}, {0x1ff2, 0x1ff4}, {0x2146, 0x2149},
|
||||
{0x2c30, 0x2c5e}, {0x2c76, 0x2c7b}, {0x2d00, 0x2d25}, {0xa72f, 0xa731},
|
||||
{0xa771, 0xa778}, {0xa793, 0xa795}, {0xab30, 0xab5a}, {0xab60, 0xab67},
|
||||
{0xab70, 0xabbf}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xff41, 0xff5a}
|
||||
#if CHRBITS > 16
|
||||
{0x3ef, 0x3f3}, {0x430, 0x45f}, {0x561, 0x587}, {0x13f8, 0x13fd},
|
||||
{0x1c80, 0x1c88}, {0x1d00, 0x1d2b}, {0x1d6b, 0x1d77}, {0x1d79, 0x1d9a},
|
||||
{0x1e95, 0x1e9d}, {0x1eff, 0x1f07}, {0x1f10, 0x1f15}, {0x1f20, 0x1f27},
|
||||
{0x1f30, 0x1f37}, {0x1f40, 0x1f45}, {0x1f50, 0x1f57}, {0x1f60, 0x1f67},
|
||||
{0x1f70, 0x1f7d}, {0x1f80, 0x1f87}, {0x1f90, 0x1f97}, {0x1fa0, 0x1fa7},
|
||||
{0x1fb0, 0x1fb4}, {0x1fc2, 0x1fc4}, {0x1fd0, 0x1fd3}, {0x1fe0, 0x1fe7},
|
||||
{0x1ff2, 0x1ff4}, {0x2146, 0x2149}, {0x2c30, 0x2c5e}, {0x2c76, 0x2c7b},
|
||||
{0x2d00, 0x2d25}, {0xa72f, 0xa731}, {0xa771, 0xa778}, {0xa793, 0xa795},
|
||||
{0xab30, 0xab5a}, {0xab60, 0xab65}, {0xab70, 0xabbf}, {0xfb00, 0xfb06},
|
||||
{0xfb13, 0xfb17}, {0xff41, 0xff5a}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10428, 0x1044f}, {0x104d8, 0x104fb}, {0x10cc0, 0x10cf2}, {0x118c0, 0x118df},
|
||||
{0x16e60, 0x16e7f}, {0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467},
|
||||
{0x1d482, 0x1d49b}, {0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf},
|
||||
{0x1d4ea, 0x1d503}, {0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f},
|
||||
{0x1d5ba, 0x1d5d3}, {0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f},
|
||||
{0x1d68a, 0x1d6a5}, {0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714},
|
||||
{0x1d716, 0x1d71b}, {0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788},
|
||||
{0x1d78a, 0x1d78f}, {0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
|
||||
{0x1d41a, 0x1d433}, {0x1d44e, 0x1d454}, {0x1d456, 0x1d467}, {0x1d482, 0x1d49b},
|
||||
{0x1d4b6, 0x1d4b9}, {0x1d4bd, 0x1d4c3}, {0x1d4c5, 0x1d4cf}, {0x1d4ea, 0x1d503},
|
||||
{0x1d51e, 0x1d537}, {0x1d552, 0x1d56b}, {0x1d586, 0x1d59f}, {0x1d5ba, 0x1d5d3},
|
||||
{0x1d5ee, 0x1d607}, {0x1d622, 0x1d63b}, {0x1d656, 0x1d66f}, {0x1d68a, 0x1d6a5},
|
||||
{0x1d6c2, 0x1d6da}, {0x1d6dc, 0x1d6e1}, {0x1d6fc, 0x1d714}, {0x1d716, 0x1d71b},
|
||||
{0x1d736, 0x1d74e}, {0x1d750, 0x1d755}, {0x1d770, 0x1d788}, {0x1d78a, 0x1d78f},
|
||||
{0x1d7aa, 0x1d7c2}, {0x1d7c4, 0x1d7c9}, {0x1e922, 0x1e943}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -507,8 +501,8 @@ static const chr lowerCharTable[] = {
|
||||
0xa763, 0xa765, 0xa767, 0xa769, 0xa76b, 0xa76d, 0xa76f, 0xa77a, 0xa77c,
|
||||
0xa77f, 0xa781, 0xa783, 0xa785, 0xa787, 0xa78c, 0xa78e, 0xa791, 0xa797,
|
||||
0xa799, 0xa79b, 0xa79d, 0xa79f, 0xa7a1, 0xa7a3, 0xa7a5, 0xa7a7, 0xa7a9,
|
||||
0xa7af, 0xa7b5, 0xa7b7, 0xa7b9, 0xa7bb, 0xa7bd, 0xa7bf, 0xa7c3, 0xa7fa
|
||||
#if CHRBITS > 16
|
||||
0xa7b5, 0xa7b7, 0xa7fa
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1d4bb, 0x1d7cb
|
||||
#endif
|
||||
};
|
||||
@@ -524,22 +518,20 @@ static const crange upperRangeTable[] = {
|
||||
{0x18e, 0x191}, {0x196, 0x198}, {0x1b1, 0x1b3}, {0x1f6, 0x1f8},
|
||||
{0x243, 0x246}, {0x388, 0x38a}, {0x391, 0x3a1}, {0x3a3, 0x3ab},
|
||||
{0x3d2, 0x3d4}, {0x3fd, 0x42f}, {0x531, 0x556}, {0x10a0, 0x10c5},
|
||||
{0x13a0, 0x13f5}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cbf}, {0x1f08, 0x1f0f},
|
||||
{0x1f18, 0x1f1d}, {0x1f28, 0x1f2f}, {0x1f38, 0x1f3f}, {0x1f48, 0x1f4d},
|
||||
{0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb}, {0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb},
|
||||
{0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb}, {0x210b, 0x210d}, {0x2110, 0x2112},
|
||||
{0x2119, 0x211d}, {0x212a, 0x212d}, {0x2130, 0x2133}, {0x2c00, 0x2c2e},
|
||||
{0x2c62, 0x2c64}, {0x2c6d, 0x2c70}, {0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae},
|
||||
{0xa7b0, 0xa7b4}, {0xa7c4, 0xa7c6}, {0xff21, 0xff3a}
|
||||
#if CHRBITS > 16
|
||||
{0x13a0, 0x13f5}, {0x1f08, 0x1f0f}, {0x1f18, 0x1f1d}, {0x1f28, 0x1f2f},
|
||||
{0x1f38, 0x1f3f}, {0x1f48, 0x1f4d}, {0x1f68, 0x1f6f}, {0x1fb8, 0x1fbb},
|
||||
{0x1fc8, 0x1fcb}, {0x1fd8, 0x1fdb}, {0x1fe8, 0x1fec}, {0x1ff8, 0x1ffb},
|
||||
{0x210b, 0x210d}, {0x2110, 0x2112}, {0x2119, 0x211d}, {0x212a, 0x212d},
|
||||
{0x2130, 0x2133}, {0x2c00, 0x2c2e}, {0x2c62, 0x2c64}, {0x2c6d, 0x2c70},
|
||||
{0x2c7e, 0x2c80}, {0xa7aa, 0xa7ae}, {0xa7b0, 0xa7b4}, {0xff21, 0xff3a}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10400, 0x10427}, {0x104b0, 0x104d3}, {0x10c80, 0x10cb2}, {0x118a0, 0x118bf},
|
||||
{0x16e40, 0x16e5f}, {0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481},
|
||||
{0x1d4a9, 0x1d4ac}, {0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a},
|
||||
{0x1d50d, 0x1d514}, {0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544},
|
||||
{0x1d54a, 0x1d550}, {0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed},
|
||||
{0x1d608, 0x1d621}, {0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0},
|
||||
{0x1d6e2, 0x1d6fa}, {0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8},
|
||||
{0x1e900, 0x1e921}
|
||||
{0x1d400, 0x1d419}, {0x1d434, 0x1d44d}, {0x1d468, 0x1d481}, {0x1d4a9, 0x1d4ac},
|
||||
{0x1d4ae, 0x1d4b5}, {0x1d4d0, 0x1d4e9}, {0x1d507, 0x1d50a}, {0x1d50d, 0x1d514},
|
||||
{0x1d516, 0x1d51c}, {0x1d53b, 0x1d53e}, {0x1d540, 0x1d544}, {0x1d54a, 0x1d550},
|
||||
{0x1d56c, 0x1d585}, {0x1d5a0, 0x1d5b9}, {0x1d5d4, 0x1d5ed}, {0x1d608, 0x1d621},
|
||||
{0x1d63c, 0x1d655}, {0x1d670, 0x1d689}, {0x1d6a8, 0x1d6c0}, {0x1d6e2, 0x1d6fa},
|
||||
{0x1d71c, 0x1d734}, {0x1d756, 0x1d76e}, {0x1d790, 0x1d7a8}, {0x1e900, 0x1e921}
|
||||
#endif
|
||||
};
|
||||
|
||||
@@ -608,9 +600,8 @@ static const chr upperCharTable[] = {
|
||||
0xa756, 0xa758, 0xa75a, 0xa75c, 0xa75e, 0xa760, 0xa762, 0xa764, 0xa766,
|
||||
0xa768, 0xa76a, 0xa76c, 0xa76e, 0xa779, 0xa77b, 0xa77d, 0xa77e, 0xa780,
|
||||
0xa782, 0xa784, 0xa786, 0xa78b, 0xa78d, 0xa790, 0xa792, 0xa796, 0xa798,
|
||||
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6,
|
||||
0xa7b8, 0xa7ba, 0xa7bc, 0xa7be, 0xa7c2
|
||||
#if CHRBITS > 16
|
||||
0xa79a, 0xa79c, 0xa79e, 0xa7a0, 0xa7a2, 0xa7a4, 0xa7a6, 0xa7a8, 0xa7b6
|
||||
#if TCL_UTF_MAX > 4
|
||||
,0x1d49c, 0x1d49e, 0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d504, 0x1d505, 0x1d538,
|
||||
0x1d539, 0x1d546, 0x1d7ca
|
||||
#endif
|
||||
@@ -625,79 +616,85 @@ static const chr upperCharTable[] = {
|
||||
static const crange graphRangeTable[] = {
|
||||
{0x21, 0x7e}, {0xa1, 0xac}, {0xae, 0x377}, {0x37a, 0x37f},
|
||||
{0x384, 0x38a}, {0x38e, 0x3a1}, {0x3a3, 0x52f}, {0x531, 0x556},
|
||||
{0x559, 0x58a}, {0x58d, 0x58f}, {0x591, 0x5c7}, {0x5d0, 0x5ea},
|
||||
{0x5ef, 0x5f4}, {0x606, 0x61b}, {0x61e, 0x6dc}, {0x6de, 0x70d},
|
||||
{0x710, 0x74a}, {0x74d, 0x7b1}, {0x7c0, 0x7fa}, {0x7fd, 0x82d},
|
||||
{0x830, 0x83e}, {0x840, 0x85b}, {0x860, 0x86a}, {0x8a0, 0x8b4},
|
||||
{0x8b6, 0x8bd}, {0x8d3, 0x8e1}, {0x8e3, 0x983}, {0x985, 0x98c},
|
||||
{0x993, 0x9a8}, {0x9aa, 0x9b0}, {0x9b6, 0x9b9}, {0x9bc, 0x9c4},
|
||||
{0x9cb, 0x9ce}, {0x9df, 0x9e3}, {0x9e6, 0x9fe}, {0xa01, 0xa03},
|
||||
{0xa05, 0xa0a}, {0xa13, 0xa28}, {0xa2a, 0xa30}, {0xa3e, 0xa42},
|
||||
{0xa4b, 0xa4d}, {0xa59, 0xa5c}, {0xa66, 0xa76}, {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, 0xc0c}, {0xc0e, 0xc10}, {0xc12, 0xc28},
|
||||
{0xc2a, 0xc39}, {0xc3d, 0xc44}, {0xc46, 0xc48}, {0xc4a, 0xc4d},
|
||||
{0xc58, 0xc5a}, {0xc60, 0xc63}, {0xc66, 0xc6f}, {0xc77, 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}, {0xe86, 0xe8a},
|
||||
{0xe8c, 0xea3}, {0xea7, 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, 0x1878}, {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}, {0x1c90, 0x1cba}, {0x1cbd, 0x1cc7}, {0x1cd0, 0x1cfa},
|
||||
{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, 0x2c2e}, {0x2c30, 0x2c5e}, {0x2c60, 0x2cf3},
|
||||
{0x2b76, 0x2b95}, {0x2b98, 0x2bb9}, {0x2bbd, 0x2bc8}, {0x2bca, 0x2bd2},
|
||||
{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, 0x2e4f},
|
||||
{0x2dc8, 0x2dce}, {0x2dd0, 0x2dd6}, {0x2dd8, 0x2dde}, {0x2de0, 0x2e49},
|
||||
{0x2e80, 0x2e99}, {0x2e9b, 0x2ef3}, {0x2f00, 0x2fd5}, {0x2ff0, 0x2ffb},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312f},
|
||||
{0x3001, 0x303f}, {0x3041, 0x3096}, {0x3099, 0x30ff}, {0x3105, 0x312e},
|
||||
{0x3131, 0x318e}, {0x3190, 0x31ba}, {0x31c0, 0x31e3}, {0x31f0, 0x321e},
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fef}, {0xa000, 0xa48c},
|
||||
{0xa490, 0xa4c6}, {0xa4d0, 0xa62b}, {0xa640, 0xa6f7}, {0xa700, 0xa7bf},
|
||||
{0xa7c2, 0xa7c6}, {0xa7f7, 0xa82b}, {0xa830, 0xa839}, {0xa840, 0xa877},
|
||||
{0xa880, 0xa8c5}, {0xa8ce, 0xa8d9}, {0xa8e0, 0xa953}, {0xa95f, 0xa97c},
|
||||
{0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe}, {0xaa00, 0xaa36},
|
||||
{0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2}, {0xaadb, 0xaaf6},
|
||||
{0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16}, {0xab20, 0xab26},
|
||||
{0xab28, 0xab2e}, {0xab30, 0xab67}, {0xab70, 0xabed}, {0xabf0, 0xabf9},
|
||||
{0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb}, {0xf900, 0xfa6d},
|
||||
{0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17}, {0xfb1d, 0xfb36},
|
||||
{0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f}, {0xfd50, 0xfd8f},
|
||||
{0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19}, {0xfe20, 0xfe52},
|
||||
{0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74}, {0xfe76, 0xfefc},
|
||||
{0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf}, {0xffd2, 0xffd7},
|
||||
{0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
|
||||
#if CHRBITS > 16
|
||||
{0x3220, 0x32fe}, {0x3300, 0x4db5}, {0x4dc0, 0x9fea}, {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},
|
||||
{0xa95f, 0xa97c}, {0xa980, 0xa9cd}, {0xa9cf, 0xa9d9}, {0xa9de, 0xa9fe},
|
||||
{0xaa00, 0xaa36}, {0xaa40, 0xaa4d}, {0xaa50, 0xaa59}, {0xaa5c, 0xaac2},
|
||||
{0xaadb, 0xaaf6}, {0xab01, 0xab06}, {0xab09, 0xab0e}, {0xab11, 0xab16},
|
||||
{0xab20, 0xab26}, {0xab28, 0xab2e}, {0xab30, 0xab65}, {0xab70, 0xabed},
|
||||
{0xabf0, 0xabf9}, {0xac00, 0xd7a3}, {0xd7b0, 0xd7c6}, {0xd7cb, 0xd7fb},
|
||||
{0xdc00, 0xdc3e}, {0xdc40, 0xdc7e}, {0xdc80, 0xdcbe}, {0xdcc0, 0xdcfe},
|
||||
{0xdd00, 0xdd3e}, {0xdd40, 0xdd7e}, {0xdd80, 0xddbe}, {0xddc0, 0xddfe},
|
||||
{0xde00, 0xde3e}, {0xde40, 0xde7e}, {0xde80, 0xdebe}, {0xdec0, 0xdefe},
|
||||
{0xdf00, 0xdf3e}, {0xdf40, 0xdf7e}, {0xdf80, 0xdfbe}, {0xdfc0, 0xdffe},
|
||||
{0xf900, 0xfa6d}, {0xfa70, 0xfad9}, {0xfb00, 0xfb06}, {0xfb13, 0xfb17},
|
||||
{0xfb1d, 0xfb36}, {0xfb38, 0xfb3c}, {0xfb46, 0xfbc1}, {0xfbd3, 0xfd3f},
|
||||
{0xfd50, 0xfd8f}, {0xfd92, 0xfdc7}, {0xfdf0, 0xfdfd}, {0xfe00, 0xfe19},
|
||||
{0xfe20, 0xfe52}, {0xfe54, 0xfe66}, {0xfe68, 0xfe6b}, {0xfe70, 0xfe74},
|
||||
{0xfe76, 0xfefc}, {0xff01, 0xffbe}, {0xffc2, 0xffc7}, {0xffca, 0xffcf},
|
||||
{0xffd2, 0xffd7}, {0xffda, 0xffdc}, {0xffe0, 0xffe6}, {0xffe8, 0xffee}
|
||||
#if TCL_UTF_MAX > 4
|
||||
,{0x10000, 0x1000b}, {0x1000d, 0x10026}, {0x10028, 0x1003a}, {0x1003f, 0x1004d},
|
||||
{0x10050, 0x1005d}, {0x10080, 0x100fa}, {0x10100, 0x10102}, {0x10107, 0x10133},
|
||||
{0x10137, 0x1018e}, {0x10190, 0x1019b}, {0x101d0, 0x101fd}, {0x10280, 0x1029c},
|
||||
@@ -708,88 +705,80 @@ static const crange graphRangeTable[] = {
|
||||
{0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080a, 0x10835}, {0x1083f, 0x10855},
|
||||
{0x10857, 0x1089e}, {0x108a7, 0x108af}, {0x108e0, 0x108f2}, {0x108fb, 0x1091b},
|
||||
{0x1091f, 0x10939}, {0x10980, 0x109b7}, {0x109bc, 0x109cf}, {0x109d2, 0x10a03},
|
||||
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a35}, {0x10a38, 0x10a3a},
|
||||
{0x10a3f, 0x10a48}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
|
||||
{0x10a0c, 0x10a13}, {0x10a15, 0x10a17}, {0x10a19, 0x10a33}, {0x10a38, 0x10a3a},
|
||||
{0x10a3f, 0x10a47}, {0x10a50, 0x10a58}, {0x10a60, 0x10a9f}, {0x10ac0, 0x10ae6},
|
||||
{0x10aeb, 0x10af6}, {0x10b00, 0x10b35}, {0x10b39, 0x10b55}, {0x10b58, 0x10b72},
|
||||
{0x10b78, 0x10b91}, {0x10b99, 0x10b9c}, {0x10ba9, 0x10baf}, {0x10c00, 0x10c48},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10d27}, {0x10d30, 0x10d39},
|
||||
{0x10e60, 0x10e7e}, {0x10f00, 0x10f27}, {0x10f30, 0x10f59}, {0x10fe0, 0x10ff6},
|
||||
{0x10c80, 0x10cb2}, {0x10cc0, 0x10cf2}, {0x10cfa, 0x10cff}, {0x10e60, 0x10e7e},
|
||||
{0x11000, 0x1104d}, {0x11052, 0x1106f}, {0x1107f, 0x110bc}, {0x110be, 0x110c1},
|
||||
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11146},
|
||||
{0x110d0, 0x110e8}, {0x110f0, 0x110f9}, {0x11100, 0x11134}, {0x11136, 0x11143},
|
||||
{0x11150, 0x11176}, {0x11180, 0x111cd}, {0x111d0, 0x111df}, {0x111e1, 0x111f4},
|
||||
{0x11200, 0x11211}, {0x11213, 0x1123e}, {0x11280, 0x11286}, {0x1128a, 0x1128d},
|
||||
{0x1128f, 0x1129d}, {0x1129f, 0x112a9}, {0x112b0, 0x112ea}, {0x112f0, 0x112f9},
|
||||
{0x11300, 0x11303}, {0x11305, 0x1130c}, {0x11313, 0x11328}, {0x1132a, 0x11330},
|
||||
{0x11335, 0x11339}, {0x1133b, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
|
||||
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x1145d, 0x1145f},
|
||||
{0x11480, 0x114c7}, {0x114d0, 0x114d9}, {0x11580, 0x115b5}, {0x115b8, 0x115dd},
|
||||
{0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166c}, {0x11680, 0x116b8},
|
||||
{0x116c0, 0x116c9}, {0x11700, 0x1171a}, {0x1171d, 0x1172b}, {0x11730, 0x1173f},
|
||||
{0x11800, 0x1183b}, {0x118a0, 0x118f2}, {0x119a0, 0x119a7}, {0x119aa, 0x119d7},
|
||||
{0x119da, 0x119e4}, {0x11a00, 0x11a47}, {0x11a50, 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}, {0x11d60, 0x11d65},
|
||||
{0x11d6a, 0x11d8e}, {0x11d93, 0x11d98}, {0x11da0, 0x11da9}, {0x11ee0, 0x11ef8},
|
||||
{0x11fc0, 0x11ff1}, {0x11fff, 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}, {0x16e40, 0x16e9a}, {0x16f00, 0x16f4a}, {0x16f4f, 0x16f87},
|
||||
{0x16f8f, 0x16f9f}, {0x16fe0, 0x16fe3}, {0x17000, 0x187f7}, {0x18800, 0x18af2},
|
||||
{0x1b000, 0x1b11e}, {0x1b150, 0x1b152}, {0x1b164, 0x1b167}, {0x1b170, 0x1b2fb},
|
||||
{0x1bc00, 0x1bc6a}, {0x1bc70, 0x1bc7c}, {0x1bc80, 0x1bc88}, {0x1bc90, 0x1bc99},
|
||||
{0x1bc9c, 0x1bc9f}, {0x1d000, 0x1d0f5}, {0x1d100, 0x1d126}, {0x1d129, 0x1d172},
|
||||
{0x1d17b, 0x1d1e8}, {0x1d200, 0x1d245}, {0x1d2e0, 0x1d2f3}, {0x1d300, 0x1d356},
|
||||
{0x1d360, 0x1d378}, {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}, {0x1e100, 0x1e12c},
|
||||
{0x1e130, 0x1e13d}, {0x1e140, 0x1e149}, {0x1e2c0, 0x1e2f9}, {0x1e800, 0x1e8c4},
|
||||
{0x1e8c7, 0x1e8d6}, {0x1e900, 0x1e94b}, {0x1e950, 0x1e959}, {0x1ec71, 0x1ecb4},
|
||||
{0x1ed01, 0x1ed3d}, {0x1ee00, 0x1ee03}, {0x1ee05, 0x1ee1f}, {0x1ee29, 0x1ee32},
|
||||
{0x11335, 0x11339}, {0x1133c, 0x11344}, {0x1134b, 0x1134d}, {0x1135d, 0x11363},
|
||||
{0x11366, 0x1136c}, {0x11370, 0x11374}, {0x11400, 0x11459}, {0x11480, 0x114c7},
|
||||
{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, 0x1f16c}, {0x1f170, 0x1f1ac},
|
||||
{0x1f1e6, 0x1f202}, {0x1f210, 0x1f23b}, {0x1f240, 0x1f248}, {0x1f260, 0x1f265},
|
||||
{0x1f300, 0x1f6d5}, {0x1f6e0, 0x1f6ec}, {0x1f6f0, 0x1f6fa}, {0x1f700, 0x1f773},
|
||||
{0x1f780, 0x1f7d8}, {0x1f7e0, 0x1f7eb}, {0x1f800, 0x1f80b}, {0x1f810, 0x1f847},
|
||||
{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},
|
||||
{0x1f90d, 0x1f971}, {0x1f973, 0x1f976}, {0x1f97a, 0x1f9a2}, {0x1f9a5, 0x1f9aa},
|
||||
{0x1f9ae, 0x1f9ca}, {0x1f9cd, 0x1fa53}, {0x1fa60, 0x1fa6d}, {0x1fa70, 0x1fa73},
|
||||
{0x1fa78, 0x1fa7a}, {0x1fa80, 0x1fa82}, {0x1fa90, 0x1fa95}, {0x20000, 0x2a6d6},
|
||||
{0x2a700, 0x2b734}, {0x2b740, 0x2b81d}, {0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0},
|
||||
{0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
{0x1f910, 0x1f93e}, {0x1f940, 0x1f94c}, {0x1f950, 0x1f96b}, {0x1f980, 0x1f997},
|
||||
{0x1f9d0, 0x1f9e6}, {0x20000, 0x2a6d6}, {0x2a700, 0x2b734}, {0x2b740, 0x2b81d},
|
||||
{0x2b820, 0x2cea1}, {0x2ceb0, 0x2ebe0}, {0x2f800, 0x2fa1d}, {0xe0100, 0xe01ef}
|
||||
#endif
|
||||
};
|
||||
|
||||
#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))
|
||||
|
||||
static const chr graphCharTable[] = {
|
||||
0x38c, 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, 0xea5,
|
||||
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
|
||||
#if CHRBITS > 16
|
||||
#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, 0x118ff, 0x11d08, 0x11d09, 0x11d3a,
|
||||
0x11d3c, 0x11d3d, 0x11d67, 0x11d68, 0x11d90, 0x11d91, 0x16a6e, 0x16a6f, 0x1d49e,
|
||||
0x1d49f, 0x1d4a2, 0x1d4a5, 0x1d4a6, 0x1d4bb, 0x1d546, 0x1e023, 0x1e024, 0x1e14e,
|
||||
0x1e14f, 0x1e2ff, 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
|
||||
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
|
||||
#endif
|
||||
};
|
||||
|
||||
|
||||
+1
-4
@@ -469,6 +469,7 @@ declare 128 {
|
||||
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)
|
||||
}
|
||||
@@ -2369,10 +2370,6 @@ declare 1 macosx {
|
||||
export {
|
||||
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
|
||||
}
|
||||
export {
|
||||
void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
|
||||
Tcl_Interp *interp)
|
||||
}
|
||||
export {
|
||||
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact)
|
||||
|
||||
+8
-4
@@ -42,6 +42,10 @@ extern "C" {
|
||||
* win/configure.in (as above)
|
||||
* win/tcl.m4 (not patchlevel)
|
||||
* 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
|
||||
* macosx/Tcl.xcode/project.pbxproj (not patchlevel) 2 LOC
|
||||
* macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC
|
||||
* macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
|
||||
* win/README (not patchlevel) (sections 0 and 2)
|
||||
* unix/tcl.spec (1 LOC patch)
|
||||
@@ -51,10 +55,10 @@ extern "C" {
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 6
|
||||
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 9
|
||||
#define TCL_RELEASE_SERIAL 7
|
||||
|
||||
#define TCL_VERSION "8.6"
|
||||
#define TCL_PATCH_LEVEL "8.6.9"
|
||||
#define TCL_PATCH_LEVEL "8.6.7"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -1982,7 +1986,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
|
||||
@@ -2618,7 +2622,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
#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
|
||||
|
||||
+13
-14
@@ -2248,24 +2248,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;
|
||||
}
|
||||
|
||||
+92
-117
@@ -234,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},
|
||||
@@ -2087,13 +2087,13 @@ Tcl_CreateCommand(
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
|
||||
if (isNew || deleted) {
|
||||
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.. */
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
@@ -2234,82 +2234,64 @@ 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;
|
||||
ImportRef *oldRefPtr = NULL;
|
||||
Namespace *nsPtr;
|
||||
Command *cmdPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
const char *tail;
|
||||
int isNew = 0, deleted = 0;
|
||||
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.
|
||||
*/
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
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) {
|
||||
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;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
/* An existing command conflicts. Try to delete it.. */
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
@@ -2343,13 +2325,7 @@ 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;
|
||||
@@ -2358,6 +2334,7 @@ TclCreateObjCommandInNs (
|
||||
TclCleanupCommandMacro(cmdPtr);
|
||||
deleted = 1;
|
||||
}
|
||||
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
@@ -2379,7 +2356,7 @@ TclCreateObjCommandInNs (
|
||||
* commands.
|
||||
*/
|
||||
|
||||
TclInvalidateCmdLiteral(interp, cmdName, nsPtr);
|
||||
TclInvalidateCmdLiteral(interp, tail, nsPtr);
|
||||
|
||||
/*
|
||||
* The list of command exported from the namespace might have changed.
|
||||
@@ -2609,6 +2586,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
|
||||
@@ -2617,14 +2598,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
|
||||
@@ -3123,7 +3100,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.
|
||||
*/
|
||||
@@ -3135,8 +3112,6 @@ Tcl_DeleteCommandFromToken(
|
||||
* traces.
|
||||
*/
|
||||
|
||||
cmdPtr->nsPtr->refCount++;
|
||||
|
||||
if (cmdPtr->tracePtr != NULL) {
|
||||
CommandTrace *tracePtr;
|
||||
CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
|
||||
@@ -3164,7 +3139,6 @@ Tcl_DeleteCommandFromToken(
|
||||
*/
|
||||
|
||||
TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
|
||||
TclNsDecrRefCount(cmdPtr->nsPtr);
|
||||
|
||||
/*
|
||||
* If the command being deleted has a compile function, increment the
|
||||
@@ -4452,8 +4426,6 @@ TclNRRunCallbacks(
|
||||
(void) Tcl_GetObjResult(interp);
|
||||
}
|
||||
|
||||
/* This is the trampoline. */
|
||||
|
||||
while (TOP_CB(interp) != rootPtr) {
|
||||
callbackPtr = TOP_CB(interp);
|
||||
procPtr = callbackPtr->procPtr;
|
||||
@@ -4587,7 +4559,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;
|
||||
}
|
||||
@@ -7606,19 +7578,7 @@ ExprEntierFunc(
|
||||
|
||||
if (type == TCL_NUMBER_DOUBLE) {
|
||||
d = *((const double *) ptr);
|
||||
if ((d < (double)LONG_MAX) && (d > (double)LONG_MIN)) {
|
||||
long result = (long) d;
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
|
||||
return TCL_OK;
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
} else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) {
|
||||
Tcl_WideInt result = (Tcl_WideInt) d;
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
|
||||
return TCL_OK;
|
||||
#endif
|
||||
} else {
|
||||
if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
|
||||
mp_int big;
|
||||
|
||||
if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
|
||||
@@ -7627,6 +7587,11 @@ ExprEntierFunc(
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
|
||||
return TCL_OK;
|
||||
} else {
|
||||
long result = (long) d;
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
|
||||
return TCL_OK;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -7735,8 +7700,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);
|
||||
@@ -8200,22 +8165,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
|
||||
@@ -8409,12 +8358,18 @@ TclNRTailcallObjCmd(
|
||||
if (objc > 1) {
|
||||
Tcl_Obj *listPtr, *nsObjPtr;
|
||||
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
|
||||
Tcl_Namespace *ns1Ptr;
|
||||
|
||||
/* The tailcall data is in a Tcl list: the first element is the
|
||||
* namespace, the rest the command to be tailcalled. */
|
||||
|
||||
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
listPtr = Tcl_NewListObj(objc, objv);
|
||||
|
||||
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|
||||
|| (nsPtr != ns1Ptr)) {
|
||||
Tcl_Panic("Tailcall failed to find the proper namespace");
|
||||
}
|
||||
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
|
||||
|
||||
iPtr->varFramePtr->tailcallPtr = listPtr;
|
||||
@@ -8995,9 +8950,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) {
|
||||
@@ -9005,21 +8960,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;
|
||||
}
|
||||
@@ -9031,9 +8999,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++;
|
||||
@@ -9094,7 +9069,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--;
|
||||
|
||||
+11
-18
@@ -1211,7 +1211,7 @@ BinaryFormatCmd(
|
||||
badField:
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
char buf[TCL_UTF_MAX + 1] = "";
|
||||
char buf[TCL_UTF_MAX + 1];
|
||||
|
||||
TclUtfToUniChar(errorString, &ch);
|
||||
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
|
||||
@@ -1581,7 +1581,7 @@ BinaryScanCmd(
|
||||
badField:
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
char buf[TCL_UTF_MAX + 1] = "";
|
||||
char buf[TCL_UTF_MAX + 1];
|
||||
|
||||
TclUtfToUniChar(errorString, &ch);
|
||||
buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
|
||||
@@ -2395,7 +2395,7 @@ BinaryDecodeHex(
|
||||
|
||||
c = *data++;
|
||||
if (!isxdigit((int) c)) {
|
||||
if (strict || !TclIsSpaceProc(c)) {
|
||||
if (strict || !isspace(c)) {
|
||||
goto badChar;
|
||||
}
|
||||
i--;
|
||||
@@ -2742,7 +2742,7 @@ BinaryDecodeUu(
|
||||
if (lineLen < 0) {
|
||||
c = *data++;
|
||||
if (c < 32 || c > 96) {
|
||||
if (strict || !TclIsSpaceProc(c)) {
|
||||
if (strict || !isspace(c)) {
|
||||
goto badUu;
|
||||
}
|
||||
i--;
|
||||
@@ -2760,7 +2760,7 @@ BinaryDecodeUu(
|
||||
d[i] = c = *data++;
|
||||
if (c < 32 || c > 96) {
|
||||
if (strict) {
|
||||
if (!TclIsSpaceProc(c)) {
|
||||
if (!isspace(c)) {
|
||||
goto badUu;
|
||||
} else if (c == '\n') {
|
||||
goto shortUu;
|
||||
@@ -2804,7 +2804,7 @@ BinaryDecodeUu(
|
||||
} else if (c >= 32 && c <= 96) {
|
||||
data--;
|
||||
break;
|
||||
} else if (strict || !TclIsSpaceProc(c)) {
|
||||
} else if (strict || !isspace(c)) {
|
||||
goto badUu;
|
||||
}
|
||||
} while (data < dataend);
|
||||
@@ -2914,11 +2914,6 @@ BinaryDecode64(
|
||||
} else if (i > 1) {
|
||||
c = '=';
|
||||
} else {
|
||||
if (strict && i <= 1) {
|
||||
/* single resp. unfulfilled char (each 4th next single char)
|
||||
* is rather bad64 error case in strict mode */
|
||||
goto bad64;
|
||||
}
|
||||
cut += 3;
|
||||
break;
|
||||
}
|
||||
@@ -2934,7 +2929,7 @@ BinaryDecode64(
|
||||
if (c == '=' && i > 1) {
|
||||
value <<= 6;
|
||||
cut++;
|
||||
} else if (!strict && TclIsSpaceProc(c)) {
|
||||
} else if (!strict && isspace(c)) {
|
||||
i--;
|
||||
} else {
|
||||
goto bad64;
|
||||
@@ -2949,12 +2944,10 @@ BinaryDecode64(
|
||||
value = (value << 6) | 0x3e;
|
||||
} else if (c == '/') {
|
||||
value = (value << 6) | 0x3f;
|
||||
} else if (c == '=' && (
|
||||
!strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
|
||||
) {
|
||||
} else if (c == '=') {
|
||||
value <<= 6;
|
||||
if (i) cut++;
|
||||
} else if (strict || !TclIsSpaceProc(c)) {
|
||||
cut++;
|
||||
} else if (strict || !isspace(c)) {
|
||||
goto bad64;
|
||||
} else {
|
||||
i--;
|
||||
@@ -2975,7 +2968,7 @@ BinaryDecode64(
|
||||
goto bad64;
|
||||
}
|
||||
for (; data < dataend; data++) {
|
||||
if (!TclIsSpaceProc(*data)) {
|
||||
if (!isspace(*data)) {
|
||||
goto bad64;
|
||||
}
|
||||
}
|
||||
|
||||
+58
-1
@@ -512,6 +512,63 @@ Tcl_ContinueObjCmd(
|
||||
return TCL_CONTINUE;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_EncodingObjCmd --
|
||||
*
|
||||
* This command manipulates encodings.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* See the user documentation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_EncodingObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
int index;
|
||||
|
||||
static const char *const optionStrings[] = {
|
||||
"convertfrom", "convertto", "dirs", "names", "system",
|
||||
NULL
|
||||
};
|
||||
enum options {
|
||||
ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
|
||||
};
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
|
||||
&index) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
switch ((enum options) index) {
|
||||
case ENC_CONVERTTO:
|
||||
return EncodingConverttoObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_CONVERTFROM:
|
||||
return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_DIRS:
|
||||
return EncodingDirsObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_NAMES:
|
||||
return EncodingNamesObjCmd(dummy, interp, objc, objv);
|
||||
case ENC_SYSTEM:
|
||||
return EncodingSystemObjCmd(dummy, interp, objc, objv);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
@@ -2127,7 +2184,7 @@ PathJoinCmd(
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0));
|
||||
Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
+49
-49
@@ -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:
|
||||
*/
|
||||
@@ -2747,10 +2754,21 @@ Tcl_LreplaceObjCmd(
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
if (first > listLen) {
|
||||
first = listLen;
|
||||
}
|
||||
|
||||
/*
|
||||
* Complain if the user asked for a start element that is greater than the
|
||||
* list length. This won't ever trigger for the "end-*" case as that will
|
||||
* be properly constrained by TclGetIntForIndex because we use listLen-1
|
||||
* (to allow for replacing the last elem).
|
||||
*/
|
||||
|
||||
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",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (last >= listLen) {
|
||||
last = listLen - 1;
|
||||
}
|
||||
@@ -2895,7 +2913,7 @@ Tcl_LsearchObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument values. */
|
||||
{
|
||||
const char *bytes, *patternBytes;
|
||||
int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
|
||||
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;
|
||||
@@ -3095,26 +3113,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;
|
||||
}
|
||||
@@ -3487,8 +3492,8 @@ Tcl_LsearchObjCmd(
|
||||
|
||||
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 {
|
||||
@@ -3509,8 +3514,8 @@ Tcl_LsearchObjCmd(
|
||||
|
||||
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 {
|
||||
@@ -3727,7 +3732,7 @@ Tcl_LsortObjCmd(
|
||||
sortInfo.isIncreasing = 1;
|
||||
break;
|
||||
case LSORT_INDEX: {
|
||||
int indexc;
|
||||
int indexc, dummy;
|
||||
Tcl_Obj **indexv;
|
||||
|
||||
if (i == objc-2) {
|
||||
@@ -3753,20 +3758,8 @@ 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;
|
||||
@@ -3846,8 +3839,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]);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -3918,7 +3911,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\""
|
||||
@@ -3937,9 +3933,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++) {
|
||||
@@ -4508,8 +4501,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) {
|
||||
|
||||
+169
-253
@@ -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;
|
||||
@@ -1080,22 +1080,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 ((ch >= 0xD800) && (len < 3)) {
|
||||
len += TclUtfToUniChar(stringPtr + len, &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);
|
||||
@@ -1425,14 +1416,9 @@ StringIndexCmd(
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
|
||||
} else {
|
||||
char buf[TCL_UTF_MAX] = "";
|
||||
char buf[TCL_UTF_MAX];
|
||||
|
||||
length = Tcl_UniCharToUtf(ch, buf);
|
||||
#if TCL_UTF_MAX > 3
|
||||
if ((ch >= 0xD800) && (length < 3)) {
|
||||
length += Tcl_UniCharToUtf(-1, buf + length);
|
||||
}
|
||||
#endif
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
|
||||
}
|
||||
}
|
||||
@@ -1576,6 +1562,7 @@ StringIsCmd(
|
||||
chcomp = Tcl_UniCharIsDigit;
|
||||
break;
|
||||
case STR_IS_DOUBLE: {
|
||||
/* TODO */
|
||||
if ((objPtr->typePtr == &tclDoubleType) ||
|
||||
(objPtr->typePtr == &tclIntType) ||
|
||||
#ifndef TCL_WIDE_INT_IS_LONG
|
||||
@@ -1796,16 +1783,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 ((ch >= 0xD800) && (length2 < 3)) {
|
||||
length2 += TclUtfToUniChar(string1 + length2, &ch);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
|
||||
}
|
||||
#endif
|
||||
if (!chcomp(fullchar)) {
|
||||
if (!chcomp(ch)) {
|
||||
result = 0;
|
||||
break;
|
||||
}
|
||||
@@ -1881,7 +1860,7 @@ StringMapCmd(
|
||||
const char *string = TclGetStringFromObj(objv[1], &length2);
|
||||
|
||||
if ((length2 > 1) &&
|
||||
strncmp(string, "-nocase", length2) == 0) {
|
||||
strncmp(string, "-nocase", (size_t) length2) == 0) {
|
||||
nocase = 1;
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -2148,7 +2127,7 @@ StringMatchCmd(
|
||||
const char *string = TclGetStringFromObj(objv[1], &length);
|
||||
|
||||
if ((length > 1) &&
|
||||
strncmp(string, "-nocase", length) == 0) {
|
||||
strncmp(string, "-nocase", (size_t) length) == 0) {
|
||||
nocase = TCL_MATCH_NOCASE;
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -2357,7 +2336,7 @@ StringRplcCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
Tcl_UniChar *ustring;
|
||||
int first, last, length, end;
|
||||
int first, last, length;
|
||||
|
||||
if (objc < 4 || objc > 5) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
|
||||
@@ -2365,38 +2344,20 @@ StringRplcCmd(
|
||||
}
|
||||
|
||||
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
|
||||
end = length - 1;
|
||||
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;
|
||||
|
||||
/*
|
||||
* We are re-fetching in case the string argument is same value as
|
||||
* an index argument, and shimmering cost us our ustring.
|
||||
*/
|
||||
|
||||
ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
|
||||
end = length-1;
|
||||
length--;
|
||||
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
@@ -2406,9 +2367,9 @@ StringRplcCmd(
|
||||
if (objc == 5) {
|
||||
Tcl_AppendObjToObj(resultPtr, objv[4]);
|
||||
}
|
||||
if (last < end) {
|
||||
if (last < length) {
|
||||
Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
|
||||
end - last);
|
||||
length - last);
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultPtr);
|
||||
}
|
||||
@@ -2604,8 +2565,10 @@ StringEqualCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
const char *string2;
|
||||
int length2, i, match, nocase = 0, reqlength = -1;
|
||||
const char *string1, *string2;
|
||||
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
|
||||
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
|
||||
strCmpFn_t strCmpFn;
|
||||
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
@@ -2616,10 +2579,10 @@ StringEqualCmd(
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length2);
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", length2)) {
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
|
||||
nocase = 1;
|
||||
} else if ((length2 > 1)
|
||||
&& !strncmp(string2, "-length", length2)) {
|
||||
&& !strncmp(string2, "-length", (size_t)length2)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
@@ -2643,7 +2606,80 @@ StringEqualCmd(
|
||||
*/
|
||||
|
||||
objv += objc-2;
|
||||
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
|
||||
|
||||
if ((reqlength == 0) || (objv[0] == objv[1])) {
|
||||
/*
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (!nocase && TclIsPureByteArray(objv[0]) &&
|
||||
TclIsPureByteArray(objv[1])) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
* case-sensitive (which is all that really makes sense with byte
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t) memcmp;
|
||||
} else if ((objv[0]->typePtr == &tclStringType)
|
||||
&& (objv[1]->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of String
|
||||
* type. In benchmark testing this proved the most efficient check
|
||||
* between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t)
|
||||
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
|
||||
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
|
||||
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
|
||||
* case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
|
||||
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
length1 = Tcl_NumUtfChars(string1, length1);
|
||||
length2 = Tcl_NumUtfChars(string2, length2);
|
||||
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
|
||||
if ((reqlength < 0) && (length1 != length2)) {
|
||||
match = 1; /* This will be reversed below. */
|
||||
} else {
|
||||
length = (length1 < length2) ? length1 : length2;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
/*
|
||||
* The requested length is negative, so we ignore it by setting it
|
||||
* to length + 1 so we correct the match var.
|
||||
*/
|
||||
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
match = strCmpFn(string1, string2, (unsigned) length);
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = length1 - length2;
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -2679,59 +2715,59 @@ StringCmpCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
int match, nocase, reqlength, status;
|
||||
const char *string1, *string2;
|
||||
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
|
||||
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
|
||||
strCmpFn_t strCmpFn;
|
||||
|
||||
status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"?-nocase? ?-length int? string1 string2");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length2);
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
|
||||
nocase = 1;
|
||||
} else if ((length2 > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length2)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
i++;
|
||||
if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad option \"%s\": must be -nocase or -length",
|
||||
string2));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
|
||||
string2, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* From now on, we only access the two objects at the end of the argument
|
||||
* array.
|
||||
*/
|
||||
|
||||
objv += objc-2;
|
||||
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclStringCmp --
|
||||
*
|
||||
* This is the core of Tcl's string comparison. It only handles byte
|
||||
* arrays, UNICODE strings and UTF-8 strings correctly.
|
||||
*
|
||||
* Results:
|
||||
* -1 if value1Ptr is less than value2Ptr, 0 if they are equal, or 1 if
|
||||
* value1Ptr is greater.
|
||||
*
|
||||
* Side effects:
|
||||
* May cause string representations of objects to be allocated.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclStringCmp(
|
||||
Tcl_Obj *value1Ptr,
|
||||
Tcl_Obj *value2Ptr,
|
||||
int checkEq, /* comparison is only for equality */
|
||||
int nocase, /* comparison is not case sensitive */
|
||||
int reqlength) /* requested length; -1 to compare whole
|
||||
* strings */
|
||||
{
|
||||
char *s1, *s2;
|
||||
int empty, length, match, s1len, s2len;
|
||||
memCmpFn_t memCmpFn;
|
||||
|
||||
if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
|
||||
if ((reqlength == 0) || (objv[0] == objv[1])) {
|
||||
/*
|
||||
* Always match at 0 chars or if it is the same obj.
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
return 0;
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (!nocase && TclIsPureByteArray(value1Ptr)
|
||||
&& TclIsPureByteArray(value2Ptr)) {
|
||||
if (!nocase && TclIsPureByteArray(objv[0]) &&
|
||||
TclIsPureByteArray(objv[1])) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
@@ -2739,113 +2775,41 @@ TclStringCmp(
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
|
||||
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = memcmp;
|
||||
} else if ((value1Ptr->typePtr == &tclStringType)
|
||||
&& (value2Ptr->typePtr == &tclStringType)) {
|
||||
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t) memcmp;
|
||||
} else if ((objv[0]->typePtr == &tclStringType)
|
||||
&& (objv[1]->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of String
|
||||
* type. If the char length == byte length, we can do a memcmp. In
|
||||
* benchmark testing this proved the most efficient check between the
|
||||
* unicode and string comparison operations.
|
||||
* type. In benchmark testing this proved the most efficient check
|
||||
* between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
if (nocase) {
|
||||
s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
|
||||
s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
|
||||
} else {
|
||||
s1len = Tcl_GetCharLength(value1Ptr);
|
||||
s2len = Tcl_GetCharLength(value2Ptr);
|
||||
if ((s1len == value1Ptr->length)
|
||||
&& (value1Ptr->bytes != NULL)
|
||||
&& (s2len == value2Ptr->length)
|
||||
&& (value2Ptr->bytes != NULL)) {
|
||||
s1 = value1Ptr->bytes;
|
||||
s2 = value2Ptr->bytes;
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
s1 = (char *) Tcl_GetUnicode(value1Ptr);
|
||||
s2 = (char *) Tcl_GetUnicode(value2Ptr);
|
||||
if (
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
1
|
||||
#else
|
||||
checkEq
|
||||
#endif /* WORDS_BIGENDIAN */
|
||||
) {
|
||||
memCmpFn = memcmp;
|
||||
s1len *= sizeof(Tcl_UniChar);
|
||||
s2len *= sizeof(Tcl_UniChar);
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
|
||||
}
|
||||
}
|
||||
}
|
||||
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t)
|
||||
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
|
||||
} else {
|
||||
/*
|
||||
* Get the string representations, being careful in case we have
|
||||
* special empty string objects about.
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
|
||||
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
|
||||
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
|
||||
* case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
empty = TclCheckEmptyString(value1Ptr);
|
||||
if (empty > 0) {
|
||||
switch (TclCheckEmptyString(value2Ptr)) {
|
||||
case -1:
|
||||
s1 = "";
|
||||
s1len = 0;
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
break;
|
||||
case 0:
|
||||
return -1;
|
||||
default: /* avoid warn: `s2` may be used uninitialized */
|
||||
return 0;
|
||||
}
|
||||
} else if (TclCheckEmptyString(value2Ptr) > 0) {
|
||||
switch (empty) {
|
||||
case -1:
|
||||
s2 = "";
|
||||
s2len = 0;
|
||||
s1 = TclGetStringFromObj(value1Ptr, &s1len);
|
||||
break;
|
||||
case 0:
|
||||
return 1;
|
||||
default: /* avoid warn: `s1` may be used uninitialized */
|
||||
return 0;
|
||||
}
|
||||
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
|
||||
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
s1 = TclGetStringFromObj(value1Ptr, &s1len);
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
}
|
||||
|
||||
if (!nocase && checkEq) {
|
||||
/*
|
||||
* When we have equal-length we can check only for (in)equality.
|
||||
* We can use memcmp() in all (n)eq cases because we don't need to
|
||||
* worry about lexical LE/BE variance.
|
||||
*/
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp()
|
||||
* as that is unsafe with any string containing NUL (\xC0\x80 in
|
||||
* Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
|
||||
* we are case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
s1len = Tcl_NumUtfChars(s1, s1len);
|
||||
s2len = Tcl_NumUtfChars(s2, s2len);
|
||||
memCmpFn = (memCmpFn_t)
|
||||
(nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
length1 = Tcl_NumUtfChars(string1, length1);
|
||||
length2 = Tcl_NumUtfChars(string2, length2);
|
||||
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
|
||||
length = (s1len < s2len) ? s1len : s2len;
|
||||
length = (length1 < length2) ? length1 : length2;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
@@ -2857,62 +2821,13 @@ TclStringCmp(
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
if (checkEq && (s1len != s2len)) {
|
||||
match = 1; /* This will be reversed below. */
|
||||
} else {
|
||||
/*
|
||||
* The comparison function should compare up to the minimum byte
|
||||
* length only.
|
||||
*/
|
||||
match = memCmpFn(s1, s2, (size_t) length);
|
||||
}
|
||||
match = strCmpFn(string1, string2, (unsigned) length);
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = s1len - s2len;
|
||||
}
|
||||
return (match > 0) ? 1 : (match < 0) ? -1 : 0;
|
||||
}
|
||||
|
||||
int TclStringCmpOpts(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[], /* Argument objects. */
|
||||
int *nocase,
|
||||
int *reqlength)
|
||||
{
|
||||
int i, length;
|
||||
const char *string;
|
||||
|
||||
*reqlength = -1;
|
||||
*nocase = 0;
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"?-nocase? ?-length int? string1 string2");
|
||||
return TCL_ERROR;
|
||||
match = length1 - length2;
|
||||
}
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string = TclGetStringFromObj(objv[i], &length);
|
||||
if ((length > 1) && !strncmp(string, "-nocase", length)) {
|
||||
*nocase = 1;
|
||||
} else if ((length > 1)
|
||||
&& !strncmp(string, "-length", length)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
i++;
|
||||
if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad option \"%s\": must be -nocase or -length",
|
||||
string));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
|
||||
string, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -3335,7 +3250,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));
|
||||
@@ -4249,7 +4165,7 @@ Tcl_TimeObjCmd(
|
||||
* Use int obj since we know time is not fractional. [Bug 1202178]
|
||||
*/
|
||||
|
||||
objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
|
||||
objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
|
||||
} else {
|
||||
objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
|
||||
}
|
||||
|
||||
+31
-47
@@ -322,22 +322,11 @@ TclCompileArraySetCmd(
|
||||
*/
|
||||
|
||||
if (isDataValid && !isDataEven) {
|
||||
/* Abandon custom compile and let invocation raise the error */
|
||||
code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
|
||||
goto done;
|
||||
|
||||
/*
|
||||
* We used to compile to the bytecode that would throw the error,
|
||||
* but that was wrong because it would not invoke the array trace
|
||||
* on the variable.
|
||||
*
|
||||
PushStringLiteral(envPtr, "list must have an even number of elements");
|
||||
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
|
||||
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
|
||||
TclEmitInt4( 0, envPtr);
|
||||
goto done;
|
||||
*
|
||||
*/
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -415,10 +404,6 @@ TclCompileArraySetCmd(
|
||||
* Start issuing instructions to write to the array.
|
||||
*/
|
||||
|
||||
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
|
||||
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
|
||||
TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
|
||||
|
||||
CompileWord(envPtr, dataTokenPtr, interp, 2);
|
||||
if (!isDataLiteral || !isDataValid) {
|
||||
/*
|
||||
@@ -443,6 +428,9 @@ TclCompileArraySetCmd(
|
||||
TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
|
||||
}
|
||||
|
||||
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
|
||||
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
|
||||
TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr);
|
||||
TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
|
||||
offsetBack = CurrentOffset(envPtr);
|
||||
Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr);
|
||||
@@ -3408,10 +3396,10 @@ TclPushVarName(
|
||||
int *isScalarPtr) /* Must not be NULL. */
|
||||
{
|
||||
register const char *p;
|
||||
const char *last, *name, *elName;
|
||||
register int n;
|
||||
const char *name, *elName;
|
||||
register int i, n;
|
||||
Tcl_Token *elemTokenPtr = NULL;
|
||||
int nameLen, elNameLen, simpleVarName, localIndex;
|
||||
int nameChars, elNameChars, simpleVarName, localIndex;
|
||||
int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;
|
||||
|
||||
/*
|
||||
@@ -3424,7 +3412,7 @@ TclPushVarName(
|
||||
|
||||
simpleVarName = 0;
|
||||
name = elName = NULL;
|
||||
nameLen = elNameLen = 0;
|
||||
nameChars = elNameChars = 0;
|
||||
localIndex = -1;
|
||||
|
||||
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
|
||||
@@ -3436,25 +3424,22 @@ TclPushVarName(
|
||||
simpleVarName = 1;
|
||||
|
||||
name = varTokenPtr[1].start;
|
||||
nameLen = varTokenPtr[1].size;
|
||||
if (name[nameLen-1] == ')') {
|
||||
nameChars = varTokenPtr[1].size;
|
||||
if (name[nameChars-1] == ')') {
|
||||
/*
|
||||
* last char is ')' => potential array reference.
|
||||
*/
|
||||
last = Tcl_UtfPrev(name + nameLen, name);
|
||||
|
||||
if (*last == ')') {
|
||||
for (p = name; p < last; p = Tcl_UtfNext(p)) {
|
||||
if (*p == '(') {
|
||||
elName = p + 1;
|
||||
elNameLen = last - elName;
|
||||
nameLen = p - name;
|
||||
break;
|
||||
}
|
||||
for (i=0,p=name ; i<nameChars ; i++,p++) {
|
||||
if (*p == '(') {
|
||||
elName = p + 1;
|
||||
elNameChars = nameChars - i - 2;
|
||||
nameChars = i;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (!(flags & TCL_NO_ELEMENT) && elNameLen) {
|
||||
if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
|
||||
/*
|
||||
* An array element, the element name is a simple string:
|
||||
* assemble the corresponding token.
|
||||
@@ -3464,7 +3449,7 @@ TclPushVarName(
|
||||
allocedTokens = 1;
|
||||
elemTokenPtr->type = TCL_TOKEN_TEXT;
|
||||
elemTokenPtr->start = elName;
|
||||
elemTokenPtr->size = elNameLen;
|
||||
elemTokenPtr->size = elNameChars;
|
||||
elemTokenPtr->numComponents = 0;
|
||||
elemTokenCount = 1;
|
||||
}
|
||||
@@ -3472,22 +3457,21 @@ TclPushVarName(
|
||||
} else if (interp && ((n = varTokenPtr->numComponents) > 1)
|
||||
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
|
||||
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
|
||||
&& (*((p = varTokenPtr[n].start + varTokenPtr[n].size)-1) == ')')
|
||||
&& (*Tcl_UtfPrev(p, varTokenPtr[n].start) == ')')) {
|
||||
&& (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {
|
||||
/*
|
||||
* Check for parentheses inside first token.
|
||||
*/
|
||||
|
||||
simpleVarName = 0;
|
||||
for (p = varTokenPtr[1].start,
|
||||
last = p + varTokenPtr[1].size; p < last; p = Tcl_UtfNext(p)) {
|
||||
for (i = 0, p = varTokenPtr[1].start;
|
||||
i < varTokenPtr[1].size; i++, p++) {
|
||||
if (*p == '(') {
|
||||
simpleVarName = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (simpleVarName) {
|
||||
int remainingLen;
|
||||
int remainingChars;
|
||||
|
||||
/*
|
||||
* Check the last token: if it is just ')', do not count it.
|
||||
@@ -3503,13 +3487,13 @@ TclPushVarName(
|
||||
}
|
||||
|
||||
name = varTokenPtr[1].start;
|
||||
nameLen = p - varTokenPtr[1].start;
|
||||
nameChars = p - varTokenPtr[1].start;
|
||||
elName = p + 1;
|
||||
remainingLen = (varTokenPtr[2].start - p) - 1;
|
||||
elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
|
||||
remainingChars = (varTokenPtr[2].start - p) - 1;
|
||||
elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
|
||||
|
||||
if (!(flags & TCL_NO_ELEMENT)) {
|
||||
if (remainingLen) {
|
||||
if (remainingChars) {
|
||||
/*
|
||||
* Make a first token with the extra characters in the first
|
||||
* token.
|
||||
@@ -3519,7 +3503,7 @@ TclPushVarName(
|
||||
allocedTokens = 1;
|
||||
elemTokenPtr->type = TCL_TOKEN_TEXT;
|
||||
elemTokenPtr->start = elName;
|
||||
elemTokenPtr->size = remainingLen;
|
||||
elemTokenPtr->size = remainingChars;
|
||||
elemTokenPtr->numComponents = 0;
|
||||
elemTokenCount = n;
|
||||
|
||||
@@ -3548,8 +3532,8 @@ TclPushVarName(
|
||||
|
||||
int hasNsQualifiers = 0;
|
||||
|
||||
for (p = name, last = p + nameLen-1; p < last; p = Tcl_UtfNext(p)) {
|
||||
if ((*p == ':') && (*(p+1) == ':')) {
|
||||
for (i = 0, p = name; i < nameChars; i++, p++) {
|
||||
if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
|
||||
hasNsQualifiers = 1;
|
||||
break;
|
||||
}
|
||||
@@ -3562,7 +3546,7 @@ TclPushVarName(
|
||||
*/
|
||||
|
||||
if (!hasNsQualifiers) {
|
||||
localIndex = TclFindCompiledLocal(name, nameLen, 1, envPtr);
|
||||
localIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
|
||||
if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
|
||||
/*
|
||||
* We'll push the name.
|
||||
@@ -3572,7 +3556,7 @@ TclPushVarName(
|
||||
}
|
||||
}
|
||||
if (interp && localIndex < 0) {
|
||||
PushLiteral(envPtr, name, nameLen);
|
||||
PushLiteral(envPtr, name, nameChars);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -3581,7 +3565,7 @@ TclPushVarName(
|
||||
*/
|
||||
|
||||
if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
|
||||
if (elNameLen) {
|
||||
if (elNameChars) {
|
||||
TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
|
||||
envPtr);
|
||||
} else {
|
||||
|
||||
+266
-140
@@ -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,116 +1464,250 @@ TclCompileLreplaceCmd(
|
||||
{
|
||||
Tcl_Token *tokenPtr, *listTokenPtr;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
int idx1, idx2, i;
|
||||
int emptyPrefix=1, suffixStart = 0;
|
||||
Tcl_Obj *tmpObj;
|
||||
int idx1, idx2, i, offset, offset2;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
/*
|
||||
* 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 (idx1 == TCL_INDEX_AFTER) {
|
||||
suffixStart = idx1;
|
||||
} else 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. */
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
if (idx2 != INDEX_END && idx2 >= 0 && idx2 < idx1) {
|
||||
idx2 = idx1 - 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* Push all the replacement values next so any errors raised in
|
||||
* creating them get raised first.
|
||||
* Work out what this [lreplace] is actually doing.
|
||||
*/
|
||||
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;
|
||||
}
|
||||
|
||||
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
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);
|
||||
tmpObj = NULL;
|
||||
CompileWord(envPtr, listTokenPtr, interp, 1);
|
||||
if (parsePtr->numWords == 4) {
|
||||
if (idx1 == 0) {
|
||||
if (idx2 == INDEX_END) {
|
||||
goto dropAll;
|
||||
}
|
||||
idx1 = idx2 + 1;
|
||||
idx2 = INDEX_END;
|
||||
goto dropEnd;
|
||||
} else if (idx2 == INDEX_END) {
|
||||
idx2 = idx1 - 1;
|
||||
idx1 = 0;
|
||||
goto dropEnd;
|
||||
} else {
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
if (idx2 < idx1) {
|
||||
idx2 = idx1 - 1;
|
||||
}
|
||||
if (idx1 > 0) {
|
||||
tmpObj = Tcl_NewIntObj(idx1);
|
||||
Tcl_IncrRefCount(tmpObj);
|
||||
}
|
||||
goto dropRange;
|
||||
}
|
||||
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;
|
||||
}
|
||||
|
||||
if (!emptyPrefix) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
for (i=4 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
|
||||
if (suffixStart == TCL_INDEX_AFTER) {
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
if (emptyPrefix) {
|
||||
PushStringLiteral(envPtr, "");
|
||||
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 {
|
||||
/* 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);
|
||||
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);
|
||||
|
||||
/*
|
||||
* Emit an error if we've been given an empty list.
|
||||
*/
|
||||
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %d", idx1), NULL), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
|
||||
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
|
||||
envPtr->codeStart + offset + 1);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
|
||||
envPtr->codeStart + offset2 + 1);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
}
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx1 - 1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
/*
|
||||
* Issue instructions to perform the operations relating to configurations
|
||||
* that do real replacement. All arguments are pushed and assembled into a
|
||||
* pair: the list of values to replace with, and the list to do the
|
||||
* surgery on.
|
||||
*/
|
||||
|
||||
replaceAll:
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
goto done;
|
||||
|
||||
replaceHead:
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
|
||||
TclEmitInt4( idx2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
replaceTail:
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr);
|
||||
TclEmitInt4( idx2, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
replaceRange:
|
||||
if (tmpObj != NULL) {
|
||||
/*
|
||||
* Emit bytecode to check the list length.
|
||||
*/
|
||||
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
|
||||
/*
|
||||
* Check the list length vs idx1.
|
||||
*/
|
||||
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr);
|
||||
TclEmitOpcode( INST_GE, envPtr);
|
||||
offset = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr);
|
||||
|
||||
/*
|
||||
* Emit an error if we've been given an empty list.
|
||||
*/
|
||||
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitOpcode( INST_LIST_LENGTH, envPtr);
|
||||
offset2 = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
|
||||
TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
|
||||
"list doesn't contain element %d", idx1), NULL), envPtr);
|
||||
CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
|
||||
Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
|
||||
envPtr->codeStart + offset + 1);
|
||||
TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
|
||||
envPtr->codeStart + offset2 + 1);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
}
|
||||
TclEmitOpcode( INST_DUP, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx1 - 1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr);
|
||||
TclEmitInt4( INDEX_END, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
TclEmitOpcode( INST_LIST_CONCAT, envPtr);
|
||||
goto done;
|
||||
|
||||
/*
|
||||
* Clean up the allocated memory.
|
||||
*/
|
||||
|
||||
done:
|
||||
if (tmpObj != NULL) {
|
||||
Tcl_DecrRefCount(tmpObj);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2807,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);
|
||||
|
||||
+147
-193
@@ -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
|
||||
@@ -1496,7 +1450,7 @@ TclSubstCompile(
|
||||
for (endTokenPtr = tokenPtr + parse.numTokens;
|
||||
tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
|
||||
int length, literal, catchRange, breakJump;
|
||||
char buf[TCL_UTF_MAX] = "";
|
||||
char buf[TCL_UTF_MAX];
|
||||
JumpFixup startFixup, okFixup, returnFixup, breakFixup;
|
||||
JumpFixup continueFixup, otherFixup, endFixup;
|
||||
|
||||
|
||||
@@ -1723,7 +1723,7 @@ TclWordKnownAtCompileTime(
|
||||
|
||||
case TCL_TOKEN_BS:
|
||||
if (tempPtr != NULL) {
|
||||
char utfBuf[TCL_UTF_MAX] = "";
|
||||
char utfBuf[TCL_UTF_MAX];
|
||||
int length = TclParseBackslash(tokenPtr->start,
|
||||
tokenPtr->size, NULL, utfBuf);
|
||||
|
||||
@@ -2337,7 +2337,7 @@ TclCompileTokens(
|
||||
{
|
||||
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
|
||||
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
|
||||
char buffer[TCL_UTF_MAX] = "";
|
||||
char buffer[TCL_UTF_MAX];
|
||||
int i, numObjsToConcat, length, adjust;
|
||||
unsigned char *entryCodeNext = envPtr->codeNext;
|
||||
#define NUM_STATIC_POS 20
|
||||
|
||||
@@ -1121,8 +1121,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 void TclInitByteCodeObj(Tcl_Obj *objPtr,
|
||||
CompileEnv *envPtr);
|
||||
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
|
||||
@@ -1494,7 +1492,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
|
||||
#endif
|
||||
|
||||
#define TclGetInt4AtPtr(p) \
|
||||
(((int) (TclGetUInt1AtPtr(p) << 24)) | \
|
||||
(((int) TclGetInt1AtPtr(p) << 24) | \
|
||||
(*((p)+1) << 16) | \
|
||||
(*((p)+2) << 8) | \
|
||||
(*((p)+3)))
|
||||
|
||||
+1
-1
@@ -1348,7 +1348,7 @@ yyparse (info)
|
||||
int yychar;
|
||||
|
||||
/* The semantic value of the look-ahead symbol. */
|
||||
YYSTYPE yylval = {0};
|
||||
YYSTYPE yylval;
|
||||
|
||||
/* Number of syntax errors so far. */
|
||||
int yynerrs;
|
||||
|
||||
@@ -153,7 +153,7 @@ typedef struct Dict {
|
||||
* must be assignable as well as readable.
|
||||
*/
|
||||
|
||||
#define DICT(dictObj) ((dictObj)->internalRep.twoPtrValue.ptr1)
|
||||
#define DICT(dictObj) (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
|
||||
|
||||
/*
|
||||
* The structure below defines the dictionary object type by means of
|
||||
@@ -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) {
|
||||
/*
|
||||
|
||||
+29
-61
@@ -1720,9 +1720,7 @@ LoadTableEncoding(
|
||||
};
|
||||
|
||||
Tcl_DStringInit(&lineString);
|
||||
if (Tcl_Gets(chan, &lineString) < 0) {
|
||||
return NULL;
|
||||
}
|
||||
Tcl_Gets(chan, &lineString);
|
||||
line = Tcl_DStringValue(&lineString);
|
||||
|
||||
fallback = (int) strtol(line, &line, 16);
|
||||
@@ -1762,11 +1760,8 @@ LoadTableEncoding(
|
||||
for (i = 0; i < numPages; i++) {
|
||||
int ch;
|
||||
const char *p;
|
||||
int expected = 3 + 16 * (16 * 4 + 1);
|
||||
|
||||
if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
|
||||
return NULL;
|
||||
}
|
||||
Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
|
||||
p = Tcl_GetString(objPtr);
|
||||
hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
|
||||
dataPtr->toUnicode[hi] = pageMemPtr;
|
||||
@@ -2301,11 +2296,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 = 0;
|
||||
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
*statePtr = 0;
|
||||
}
|
||||
result = TCL_OK;
|
||||
|
||||
srcStart = src;
|
||||
@@ -2357,19 +2349,12 @@ UtfToUtfProc(
|
||||
* incomplete char its bytes 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 {
|
||||
int len = TclUtfToUniChar(src, chPtr);
|
||||
src += len;
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((*chPtr >= 0xD800) && (len < 3)) {
|
||||
src += TclUtfToUniChar(src + len, chPtr);
|
||||
dst += Tcl_UniCharToUtf(*chPtr, dst);
|
||||
}
|
||||
#endif
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
dst += Tcl_UniCharToUtf(ch, dst);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2425,11 +2410,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 = 0;
|
||||
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
*statePtr = 0;
|
||||
}
|
||||
if (flags & TCL_ENCODING_CHAR_LIMIT) {
|
||||
charLimit = *dstCharsPtr;
|
||||
}
|
||||
@@ -2457,11 +2439,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);
|
||||
}
|
||||
@@ -2518,11 +2500,8 @@ UtfToUnicodeProc(
|
||||
{
|
||||
const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
|
||||
int result, numChars;
|
||||
Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
|
||||
Tcl_UniChar ch = 0;
|
||||
|
||||
if (flags & TCL_ENCODING_START) {
|
||||
*statePtr = 0;
|
||||
}
|
||||
srcStart = src;
|
||||
srcEnd = src + srcLen;
|
||||
srcClose = srcEnd;
|
||||
@@ -2548,7 +2527,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
|
||||
@@ -2557,23 +2536,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
|
||||
}
|
||||
@@ -2775,7 +2754,7 @@ TableFromUtfProc(
|
||||
}
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
|
||||
#if TCL_UTF_MAX > 4
|
||||
#if TCL_UTF_MAX > 3
|
||||
/*
|
||||
* This prevents a crash condition. More evaluation is required for
|
||||
* full support of int Tcl_UniChar. [Bug 1004065]
|
||||
@@ -2784,10 +2763,6 @@ TableFromUtfProc(
|
||||
if (ch & 0xffff0000) {
|
||||
word = 0;
|
||||
} else
|
||||
#elif TCL_UTF_MAX == 4
|
||||
if (!len) {
|
||||
word = 0;
|
||||
} else
|
||||
#endif
|
||||
word = fromUnicode[(ch >> 8)][ch & 0xff];
|
||||
|
||||
@@ -2985,18 +2960,11 @@ Iso88591FromUtfProc(
|
||||
* Check for illegal characters.
|
||||
*/
|
||||
|
||||
if (ch > 0xff
|
||||
#if TCL_UTF_MAX == 4
|
||||
|| ((ch >= 0xD800) && (len < 3))
|
||||
#endif
|
||||
) {
|
||||
if (ch > 0xff) {
|
||||
if (flags & TCL_ENCODING_STOPONERROR) {
|
||||
result = TCL_CONVERT_UNKNOWN;
|
||||
break;
|
||||
}
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((ch >= 0xD800) && (len < 3)) len = 4;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Plunge on, using '?' as a fallback character.
|
||||
@@ -3425,7 +3393,7 @@ EscapeFromUtfProc(
|
||||
break;
|
||||
}
|
||||
memcpy(dst, subTablePtr->sequence,
|
||||
subTablePtr->sequenceLen);
|
||||
(size_t) subTablePtr->sequenceLen);
|
||||
dst += subTablePtr->sequenceLen;
|
||||
}
|
||||
}
|
||||
|
||||
+169
-225
@@ -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_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
|
||||
)
|
||||
Tcl_CreateEnsemble(
|
||||
Tcl_Interp *interp,
|
||||
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);
|
||||
}
|
||||
|
||||
@@ -2071,8 +2038,8 @@ TclResetRewriteEnsemble(
|
||||
*
|
||||
* TclSpellFix --
|
||||
*
|
||||
* Record a spelling correction that needs making in the generation of
|
||||
* the WrongNumArgs usage message.
|
||||
* Record a spelling correction that needs making in the
|
||||
* generation of the WrongNumArgs usage message.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -2089,10 +2056,9 @@ FreeER(
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
{
|
||||
Tcl_Obj **tmp = (Tcl_Obj **) data[0];
|
||||
Tcl_Obj **store = (Tcl_Obj **) data[1];
|
||||
Tcl_Obj **tmp = (Tcl_Obj **)data[0];
|
||||
|
||||
ckfree(store);
|
||||
ckfree(tmp[2]);
|
||||
ckfree(tmp);
|
||||
return result;
|
||||
}
|
||||
@@ -2118,28 +2084,22 @@ TclSpellFix(
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Compute the valid length of the ensemble root.
|
||||
*/
|
||||
/* Compute the valid length of the ensemble root */
|
||||
|
||||
size = iPtr->ensembleRewrite.numRemovedObjs + objc
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
/*
|
||||
* Awful casting abuse here!
|
||||
*/
|
||||
|
||||
/* Awful casting abuse here */
|
||||
search = (Tcl_Obj *const *) search[1];
|
||||
}
|
||||
|
||||
if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
|
||||
/*
|
||||
* Misspelled value was inserted. We cannot directly jump to the bad
|
||||
* value, but have to search.
|
||||
* Misspelled value was inserted. We cannot directly jump
|
||||
* to the bad value, but have to search.
|
||||
*/
|
||||
|
||||
idx = 1;
|
||||
while (idx < size) {
|
||||
if (search[idx] == bad) {
|
||||
@@ -2151,10 +2111,7 @@ TclSpellFix(
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* Jump to the misspelled value.
|
||||
*/
|
||||
|
||||
/* Jump to the misspelled value. */
|
||||
idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
@@ -2166,26 +2123,17 @@ TclSpellFix(
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
store = (Tcl_Obj **) search[2];
|
||||
store = (Tcl_Obj **)search[2];
|
||||
} else {
|
||||
Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
|
||||
|
||||
store = ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(store, iPtr->ensembleRewrite.sourceObjs,
|
||||
size * sizeof(Tcl_Obj *));
|
||||
|
||||
/*
|
||||
* Awful casting abuse here! Note that the NULL in the first element
|
||||
* indicates that the initial objects are a raw array in the second
|
||||
* element and the rewritten ones are a raw array in the third.
|
||||
*/
|
||||
|
||||
tmp[0] = NULL;
|
||||
tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *) store;
|
||||
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
|
||||
tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
|
||||
|
||||
TclNRAddCallback(interp, FreeER, tmp, store, NULL, NULL);
|
||||
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
|
||||
TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
|
||||
store = (Tcl_Obj **)tmp[2];
|
||||
}
|
||||
|
||||
store[idx] = fix;
|
||||
@@ -2450,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
|
||||
@@ -2509,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);
|
||||
}
|
||||
@@ -2539,9 +2479,10 @@ DeleteEnsembleConfig(
|
||||
* BuildEnsembleConfig --
|
||||
*
|
||||
* Create the internal data structures that describe how an ensemble
|
||||
* looks, being a hash mapping from the simple command name to the Tcl list
|
||||
* looks, being a hash mapping from the full command name to the Tcl list
|
||||
* that describes the implementation prefix words, and a sorted array of
|
||||
* the names to allow for reasonably efficient unambiguous prefix handling.
|
||||
* all the full command names to allow for reasonably efficient
|
||||
* unambiguous prefix handling.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -2564,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.
|
||||
@@ -2694,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);
|
||||
|
||||
+1
-13
@@ -130,7 +130,6 @@ TclSetupEnv(
|
||||
* '='; ignore the entry.
|
||||
*/
|
||||
|
||||
Tcl_DStringFree(&envString);
|
||||
continue;
|
||||
}
|
||||
p2++;
|
||||
@@ -723,25 +722,14 @@ TclFinalizeEnvironment(void)
|
||||
* strings. This may leak more memory that strictly necessary, since some
|
||||
* of the strings may no longer be in the environment. However,
|
||||
* determining which ones are ok to delete is n-squared, and is pretty
|
||||
* unlikely, so we don't bother. However, in the case of DPURIFY, just
|
||||
* free all strings in the cache.
|
||||
* unlikely, so we don't bother.
|
||||
*/
|
||||
|
||||
if (env.cache) {
|
||||
#ifdef PURIFY
|
||||
int i;
|
||||
for (i = 0; i < env.cacheSize; i++) {
|
||||
ckfree(env.cache[i]);
|
||||
}
|
||||
#endif
|
||||
ckfree(env.cache);
|
||||
env.cache = NULL;
|
||||
env.cacheSize = 0;
|
||||
#ifndef USE_PUTENV
|
||||
if ((env.ourEnviron != NULL)) {
|
||||
ckfree(env.ourEnviron);
|
||||
env.ourEnviron = NULL;
|
||||
}
|
||||
env.ourEnvironSize = 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
+183
-135
@@ -1333,12 +1333,12 @@ TclStackAlloc(
|
||||
int numBytes)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int numWords;
|
||||
int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
|
||||
|
||||
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
|
||||
return (void *) ckalloc(numBytes);
|
||||
}
|
||||
numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
|
||||
|
||||
return (void *) StackAllocWords(interp, numWords);
|
||||
}
|
||||
|
||||
@@ -2014,7 +2014,7 @@ ArgumentBCEnter(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
#define bcFramePtr (&TD->cmdFrame)
|
||||
#define initCatchTop ((ptrdiff_t *) (TD->stack-1))
|
||||
#define initCatchTop ((ptrdiff_t *) (&TD->stack[-1]))
|
||||
#define initTosPtr ((Tcl_Obj **) (initCatchTop+codePtr->maxExceptDepth))
|
||||
#define esPtr (iPtr->execEnvPtr->execStackPtr)
|
||||
|
||||
@@ -4169,8 +4169,7 @@ TEBCresume(
|
||||
}
|
||||
TRACE(("%s %u \"%.30s\" => ",
|
||||
(flags ? "normal" : "noerr"), opnd, O2S(part2Ptr)));
|
||||
if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)
|
||||
&& !(arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
|
||||
if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) {
|
||||
varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr);
|
||||
if (varPtr && TclIsVarDirectUnsettable(varPtr)) {
|
||||
/*
|
||||
@@ -4295,12 +4294,17 @@ TEBCresume(
|
||||
varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, 0, NULL,
|
||||
/*createPart1*/0, /*createPart2*/0, &arrayPtr);
|
||||
doArrayExists:
|
||||
DECACHE_STACK_INFO();
|
||||
result = TclCheckArrayTraces(interp, varPtr, arrayPtr, part1Ptr, opnd);
|
||||
CACHE_STACK_INFO();
|
||||
if (result == TCL_ERROR) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
|
||||
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
|
||||
DECACHE_STACK_INFO();
|
||||
result = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,
|
||||
NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|
|
||||
TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd);
|
||||
CACHE_STACK_INFO();
|
||||
if (result == TCL_ERROR) {
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
}
|
||||
}
|
||||
if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
|
||||
objResultPtr = TCONST(1);
|
||||
@@ -5085,9 +5089,16 @@ TEBCresume(
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
/* Decode end-offset index values. */
|
||||
/*
|
||||
* Select the list item based on the index. Negative operand means
|
||||
* end-based indexing.
|
||||
*/
|
||||
|
||||
index = TclIndexDecode(opnd, objc - 1);
|
||||
if (opnd < -1) {
|
||||
index = opnd+1 + objc;
|
||||
} else {
|
||||
index = opnd;
|
||||
}
|
||||
pcAdjustment = 5;
|
||||
|
||||
lindexFastPath:
|
||||
@@ -5235,68 +5246,60 @@ TEBCresume(
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Every range of an empty list is an empty list */
|
||||
if (objc == 0) {
|
||||
/* avoid return of not canonical list (e. g. spaces in string repr.) */
|
||||
if (!valuePtr->bytes || !valuePtr->length) {
|
||||
TRACE_APPEND(("\n"));
|
||||
NEXT_INST_F(9, 0, 0);
|
||||
}
|
||||
goto emptyList;
|
||||
}
|
||||
|
||||
/* Decode index value operands. */
|
||||
|
||||
/*
|
||||
assert ( toIdx != TCL_INDEX_AFTER);
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
*/
|
||||
if (toIdx == TCL_INDEX_AFTER) {
|
||||
toIdx = TCL_INDEX_END;
|
||||
}
|
||||
|
||||
if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) {
|
||||
goto emptyList;
|
||||
}
|
||||
toIdx = TclIndexDecode(toIdx, objc - 1);
|
||||
if (toIdx < 0) {
|
||||
goto emptyList;
|
||||
} else if (toIdx >= objc) {
|
||||
toIdx = objc - 1;
|
||||
}
|
||||
|
||||
assert ( toIdx >= 0 && toIdx < objc);
|
||||
/*
|
||||
assert ( fromIdx != TCL_INDEX_BEFORE );
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
* Adjust the indices for end-based handling.
|
||||
*/
|
||||
if (fromIdx == TCL_INDEX_BEFORE) {
|
||||
fromIdx = TCL_INDEX_START;
|
||||
}
|
||||
|
||||
fromIdx = TclIndexDecode(fromIdx, objc - 1);
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
|
||||
if (fromIdx <= toIdx) {
|
||||
/* Construct the subsquence list */
|
||||
/* unshared optimization */
|
||||
if (Tcl_IsShared(valuePtr)) {
|
||||
objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
|
||||
} else {
|
||||
if (toIdx != objc - 1) {
|
||||
Tcl_ListObjReplace(NULL, valuePtr, toIdx + 1, LIST_MAX,
|
||||
0, NULL);
|
||||
}
|
||||
Tcl_ListObjReplace(NULL, valuePtr, 0, fromIdx, 0, NULL);
|
||||
TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
|
||||
NEXT_INST_F(9, 0, 0);
|
||||
if (fromIdx < -1) {
|
||||
fromIdx += 1+objc;
|
||||
if (fromIdx < -1) {
|
||||
fromIdx = -1;
|
||||
}
|
||||
} else if (fromIdx > objc) {
|
||||
fromIdx = objc;
|
||||
}
|
||||
if (toIdx < -1) {
|
||||
toIdx += 1 + objc;
|
||||
if (toIdx < -1) {
|
||||
toIdx = -1;
|
||||
}
|
||||
} else if (toIdx > objc) {
|
||||
toIdx = objc;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check if we are referring to a valid, non-empty list range, and if
|
||||
* so, build the list of elements in that range.
|
||||
*/
|
||||
|
||||
if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
if (toIdx >= objc) {
|
||||
toIdx = objc-1;
|
||||
}
|
||||
if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
|
||||
/*
|
||||
* BEWARE! This is looking inside the implementation of the
|
||||
* list type.
|
||||
*/
|
||||
|
||||
List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;
|
||||
|
||||
if (listPtr->refCount == 1) {
|
||||
for (index=toIdx+1; index<objc ; index++) {
|
||||
TclDecrRefCount(objv[index]);
|
||||
}
|
||||
listPtr->elemCount = toIdx+1;
|
||||
listPtr->canonicalFlag = 1;
|
||||
TclInvalidateStringRep(valuePtr);
|
||||
TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
|
||||
NEXT_INST_F(9, 0, 0);
|
||||
}
|
||||
}
|
||||
objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
|
||||
} else {
|
||||
emptyList:
|
||||
TclNewObj(objResultPtr);
|
||||
}
|
||||
|
||||
@@ -5388,10 +5391,88 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
|
||||
{
|
||||
if (valuePtr == value2Ptr) {
|
||||
match = 0;
|
||||
} else {
|
||||
/*
|
||||
* We only need to check (in)equality when we have equal length
|
||||
* strings. We can use memcmp in all (n)eq cases because we
|
||||
* don't need to worry about lexical LE/BE variance.
|
||||
*/
|
||||
|
||||
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
|
||||
memCmpFn_t memCmpFn;
|
||||
int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
|
||||
|| (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
|
||||
match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
|
||||
|
||||
if (TclIsPureByteArray(valuePtr)
|
||||
&& TclIsPureByteArray(value2Ptr)) {
|
||||
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
|
||||
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = memcmp;
|
||||
} else if ((valuePtr->typePtr == &tclStringType)
|
||||
&& (value2Ptr->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of
|
||||
* String type. If the char length == byte length, we can do a
|
||||
* memcmp. In benchmark testing this proved the most efficient
|
||||
* check between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
s1len = Tcl_GetCharLength(valuePtr);
|
||||
s2len = Tcl_GetCharLength(value2Ptr);
|
||||
if ((s1len == valuePtr->length)
|
||||
&& (valuePtr->bytes != NULL)
|
||||
&& (s2len == value2Ptr->length)
|
||||
&& (value2Ptr->bytes != NULL)) {
|
||||
s1 = valuePtr->bytes;
|
||||
s2 = value2Ptr->bytes;
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
s1 = (char *) Tcl_GetUnicode(valuePtr);
|
||||
s2 = (char *) Tcl_GetUnicode(value2Ptr);
|
||||
if (
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
1
|
||||
#else
|
||||
checkEq
|
||||
#endif
|
||||
) {
|
||||
memCmpFn = memcmp;
|
||||
s1len *= sizeof(Tcl_UniChar);
|
||||
s2len *= sizeof(Tcl_UniChar);
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* strcmp can't do a simple memcmp in order to handle the
|
||||
* special Tcl \xC0\x80 null encoding for utf-8.
|
||||
*/
|
||||
|
||||
s1 = TclGetStringFromObj(valuePtr, &s1len);
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
if (checkEq) {
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
|
||||
}
|
||||
}
|
||||
|
||||
if (checkEq && (s1len != s2len)) {
|
||||
match = 1;
|
||||
} else {
|
||||
/*
|
||||
* The comparison function should compare up to the minimum
|
||||
* byte length only.
|
||||
*/
|
||||
match = memCmpFn(s1, s2,
|
||||
(size_t) ((s1len < s2len) ? s1len : s2len));
|
||||
if (match == 0) {
|
||||
match = s1len - s2len;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -5515,7 +5596,7 @@ TEBCresume(
|
||||
objResultPtr = Tcl_NewStringObj((const char *)
|
||||
valuePtr->bytes+index, 1);
|
||||
} else {
|
||||
char buf[TCL_UTF_MAX] = "";
|
||||
char buf[TCL_UTF_MAX];
|
||||
Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
|
||||
|
||||
/*
|
||||
@@ -5564,58 +5645,31 @@ TEBCresume(
|
||||
length = Tcl_GetCharLength(valuePtr);
|
||||
TRACE(("\"%.20s\" %d %d => ", O2S(valuePtr), fromIdx, toIdx));
|
||||
|
||||
/* Every range of an empty value is an empty value */
|
||||
if (length == 0) {
|
||||
TRACE_APPEND(("\n"));
|
||||
NEXT_INST_F(9, 0, 0);
|
||||
}
|
||||
|
||||
/* Decode index operands. */
|
||||
|
||||
/*
|
||||
assert ( toIdx != TCL_INDEX_BEFORE );
|
||||
assert ( toIdx != TCL_INDEX_AFTER);
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
* Adjust indices for end-based indexing.
|
||||
*/
|
||||
if (toIdx == TCL_INDEX_BEFORE) {
|
||||
goto emptyRange;
|
||||
}
|
||||
if (toIdx == TCL_INDEX_AFTER) {
|
||||
toIdx = TCL_INDEX_END;
|
||||
}
|
||||
|
||||
toIdx = TclIndexDecode(toIdx, length - 1);
|
||||
if (toIdx < 0) {
|
||||
goto emptyRange;
|
||||
if (fromIdx < -1) {
|
||||
fromIdx += 1 + length;
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
} else if (fromIdx >= length) {
|
||||
fromIdx = length;
|
||||
}
|
||||
if (toIdx < -1) {
|
||||
toIdx += 1 + length;
|
||||
} else if (toIdx >= length) {
|
||||
toIdx = length - 1;
|
||||
}
|
||||
|
||||
assert ( toIdx >= 0 && toIdx < length );
|
||||
|
||||
/*
|
||||
assert ( fromIdx != TCL_INDEX_BEFORE );
|
||||
assert ( fromIdx != TCL_INDEX_AFTER);
|
||||
*
|
||||
* Extra safety for legacy bytecodes:
|
||||
* Check if we can do a sane substring.
|
||||
*/
|
||||
if (fromIdx == TCL_INDEX_BEFORE) {
|
||||
fromIdx = TCL_INDEX_START;
|
||||
}
|
||||
if (fromIdx == TCL_INDEX_AFTER) {
|
||||
goto emptyRange;
|
||||
}
|
||||
|
||||
fromIdx = TclIndexDecode(fromIdx, length - 1);
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
|
||||
if (fromIdx <= toIdx) {
|
||||
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
|
||||
} else {
|
||||
emptyRange:
|
||||
TclNewObj(objResultPtr);
|
||||
}
|
||||
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
|
||||
@@ -5623,18 +5677,18 @@ TEBCresume(
|
||||
|
||||
{
|
||||
Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p;
|
||||
int length3, endIdx;
|
||||
int length3;
|
||||
Tcl_Obj *value3Ptr;
|
||||
|
||||
case INST_STR_REPLACE:
|
||||
value3Ptr = POP_OBJECT();
|
||||
valuePtr = OBJ_AT_DEPTH(2);
|
||||
endIdx = Tcl_GetCharLength(valuePtr) - 1;
|
||||
length = Tcl_GetCharLength(valuePtr) - 1;
|
||||
TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr),
|
||||
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr)));
|
||||
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, endIdx,
|
||||
if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length,
|
||||
&fromIdx) != TCL_OK
|
||||
|| TclGetIntForIndexM(interp, OBJ_AT_TOS, endIdx,
|
||||
|| TclGetIntForIndexM(interp, OBJ_AT_TOS, length,
|
||||
&toIdx) != TCL_OK) {
|
||||
TclDecrRefCount(value3Ptr);
|
||||
TRACE_ERROR(interp);
|
||||
@@ -5644,24 +5698,21 @@ TEBCresume(
|
||||
(void) POP_OBJECT();
|
||||
TclDecrRefCount(OBJ_AT_TOS);
|
||||
(void) POP_OBJECT();
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
}
|
||||
|
||||
if ((toIdx < 0) ||
|
||||
(fromIdx > endIdx) ||
|
||||
(toIdx < fromIdx)) {
|
||||
if (fromIdx > toIdx || fromIdx > length) {
|
||||
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
|
||||
TclDecrRefCount(value3Ptr);
|
||||
NEXT_INST_F(1, 0, 0);
|
||||
}
|
||||
|
||||
if (fromIdx < 0) {
|
||||
fromIdx = 0;
|
||||
if (toIdx > length) {
|
||||
toIdx = length;
|
||||
}
|
||||
|
||||
if (toIdx > endIdx) {
|
||||
toIdx = endIdx;
|
||||
}
|
||||
|
||||
if (fromIdx == 0 && toIdx == endIdx) {
|
||||
if (fromIdx == 0 && toIdx == length) {
|
||||
TclDecrRefCount(OBJ_AT_TOS);
|
||||
OBJ_AT_TOS = value3Ptr;
|
||||
TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr)));
|
||||
@@ -5944,7 +5995,12 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS; /* TrimSet */
|
||||
string2 = TclGetStringFromObj(value2Ptr, &length2);
|
||||
string1 = TclGetStringFromObj(valuePtr, &length);
|
||||
trim1 = TclTrim(string1, length, string2, length2, &trim2);
|
||||
trim1 = TclTrimLeft(string1, length, string2, length2);
|
||||
if (trim1 < length) {
|
||||
trim2 = TclTrimRight(string1, length, string2, length2);
|
||||
} else {
|
||||
trim2 = 0;
|
||||
}
|
||||
createTrimmedString:
|
||||
/*
|
||||
* Careful here; trim set often contains non-ASCII characters so we
|
||||
@@ -6068,14 +6124,6 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
|
||||
/*
|
||||
Try to determine, without triggering generation of a string
|
||||
representation, whether one value is not a number.
|
||||
*/
|
||||
if (TclCheckEmptyString(valuePtr) > 0 || TclCheckEmptyString(value2Ptr) > 0) {
|
||||
goto stringCompare;
|
||||
}
|
||||
|
||||
if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK
|
||||
|| GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2) != TCL_OK) {
|
||||
/*
|
||||
|
||||
+25
-31
@@ -180,7 +180,7 @@ FileCopyRename(
|
||||
}
|
||||
jargv[0] = objv[objc - 1];
|
||||
jargv[1] = source;
|
||||
newFileName = TclJoinPath(2, jargv, 1);
|
||||
newFileName = TclJoinPath(2, jargv);
|
||||
Tcl_IncrRefCount(newFileName);
|
||||
result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
|
||||
force);
|
||||
@@ -240,13 +240,9 @@ TclFileMakeDirsCmd(
|
||||
break;
|
||||
}
|
||||
for (j = 0; j < pobjc; j++) {
|
||||
int errCount = 2;
|
||||
|
||||
target = Tcl_FSJoinPath(split, j + 1);
|
||||
Tcl_IncrRefCount(target);
|
||||
|
||||
createDir:
|
||||
|
||||
/*
|
||||
* Call Tcl_FSStat() so that if target is a symlink that points to
|
||||
* a directory we will create subdirectories in that directory.
|
||||
@@ -273,25 +269,23 @@ TclFileMakeDirsCmd(
|
||||
* subdirectory.
|
||||
*/
|
||||
|
||||
if (errno == EEXIST) {
|
||||
/* Be aware other workers could delete it immediately after
|
||||
* creation, so give this worker still one chance (repeat once),
|
||||
* see [270f78ca95] for description of the race-condition.
|
||||
* Don't repeat the create always (to avoid endless loop). */
|
||||
if (--errCount > 0) {
|
||||
goto createDir;
|
||||
}
|
||||
/* Already tried, with delete in-between directly after
|
||||
* creation, so just continue (assume created successful). */
|
||||
goto nextPart;
|
||||
}
|
||||
if (errno != EEXIST) {
|
||||
errfile = target;
|
||||
goto done;
|
||||
} else if ((Tcl_FSStat(target, &statBuf) == 0)
|
||||
&& S_ISDIR(statBuf.st_mode)) {
|
||||
/*
|
||||
* It is a directory that wasn't there before, so keep
|
||||
* going without error.
|
||||
*/
|
||||
|
||||
/* return with error */
|
||||
errfile = target;
|
||||
goto done;
|
||||
Tcl_ResetResult(interp);
|
||||
} else {
|
||||
errfile = target;
|
||||
goto done;
|
||||
}
|
||||
}
|
||||
|
||||
nextPart:
|
||||
/*
|
||||
* Forget about this sub-path.
|
||||
*/
|
||||
@@ -369,7 +363,14 @@ TclFileDeleteCmd(
|
||||
*/
|
||||
|
||||
if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
|
||||
result = TCL_ERROR;
|
||||
/*
|
||||
* Trying to delete a file that does not exist is not considered
|
||||
* an error, just a no-op
|
||||
*/
|
||||
|
||||
if (errno != ENOENT) {
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
} else if (S_ISDIR(statBuf.st_mode)) {
|
||||
/*
|
||||
* We own a reference count on errorBuffer, if it was set as a
|
||||
@@ -405,20 +406,13 @@ TclFileDeleteCmd(
|
||||
}
|
||||
|
||||
if (result != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
|
||||
/*
|
||||
* Avoid possible race condition (file/directory deleted after call
|
||||
* of lstat), so bypass ENOENT because not an error, just a no-op
|
||||
*/
|
||||
if (errno == ENOENT) {
|
||||
result = TCL_OK;
|
||||
continue;
|
||||
}
|
||||
/*
|
||||
* It is important that we break on error, otherwise we might end
|
||||
* up owning reference counts on numerous errorBuffers.
|
||||
*/
|
||||
result = TCL_ERROR;
|
||||
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
@@ -808,24 +808,24 @@ Tcl_FSJoinToPath(
|
||||
Tcl_Obj *const objv[]) /* Path elements to join. */
|
||||
{
|
||||
if (pathPtr == NULL) {
|
||||
return TclJoinPath(objc, objv, 0);
|
||||
return TclJoinPath(objc, objv);
|
||||
}
|
||||
if (objc == 0) {
|
||||
return TclJoinPath(1, &pathPtr, 0);
|
||||
return TclJoinPath(1, &pathPtr);
|
||||
}
|
||||
if (objc == 1) {
|
||||
Tcl_Obj *pair[2];
|
||||
|
||||
pair[0] = pathPtr;
|
||||
pair[1] = objv[0];
|
||||
return TclJoinPath(2, pair, 0);
|
||||
return TclJoinPath(2, pair);
|
||||
} else {
|
||||
int elemc = objc + 1;
|
||||
Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));
|
||||
|
||||
elemv[0] = pathPtr;
|
||||
memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
|
||||
ret = TclJoinPath(elemc, elemv, 0);
|
||||
ret = TclJoinPath(elemc, elemv);
|
||||
ckfree(elemv);
|
||||
return ret;
|
||||
}
|
||||
@@ -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.
|
||||
|
||||
@@ -897,7 +897,7 @@ TclDatelex(
|
||||
|
||||
location->first_column = yyInput - info->dateStart;
|
||||
for ( ; ; ) {
|
||||
while (TclIsSpaceProc(*yyInput)) {
|
||||
while (isspace(UCHAR(*yyInput))) {
|
||||
yyInput++;
|
||||
}
|
||||
|
||||
|
||||
+5
-8
@@ -1014,18 +1014,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) {
|
||||
@@ -1037,6 +1031,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.
|
||||
|
||||
+9
-13
@@ -711,18 +711,17 @@ Tcl_SetStdChannel(
|
||||
{
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
int init = channel ? 1 : -1;
|
||||
switch (type) {
|
||||
case TCL_STDIN:
|
||||
tsdPtr->stdinInitialized = init;
|
||||
tsdPtr->stdinInitialized = 1;
|
||||
tsdPtr->stdinChannel = channel;
|
||||
break;
|
||||
case TCL_STDOUT:
|
||||
tsdPtr->stdoutInitialized = init;
|
||||
tsdPtr->stdoutInitialized = 1;
|
||||
tsdPtr->stdoutChannel = channel;
|
||||
break;
|
||||
case TCL_STDERR:
|
||||
tsdPtr->stderrInitialized = init;
|
||||
tsdPtr->stderrInitialized = 1;
|
||||
tsdPtr->stderrChannel = channel;
|
||||
break;
|
||||
}
|
||||
@@ -759,8 +758,8 @@ Tcl_GetStdChannel(
|
||||
switch (type) {
|
||||
case TCL_STDIN:
|
||||
if (!tsdPtr->stdinInitialized) {
|
||||
tsdPtr->stdinInitialized = -1;
|
||||
tsdPtr->stdinChannel = TclpGetDefaultStdChannel(TCL_STDIN);
|
||||
tsdPtr->stdinInitialized = 1;
|
||||
|
||||
/*
|
||||
* Artificially bump the refcount to ensure that the channel is
|
||||
@@ -772,7 +771,6 @@ Tcl_GetStdChannel(
|
||||
*/
|
||||
|
||||
if (tsdPtr->stdinChannel != NULL) {
|
||||
tsdPtr->stdinInitialized = 1;
|
||||
Tcl_RegisterChannel(NULL, tsdPtr->stdinChannel);
|
||||
}
|
||||
}
|
||||
@@ -780,10 +778,9 @@ Tcl_GetStdChannel(
|
||||
break;
|
||||
case TCL_STDOUT:
|
||||
if (!tsdPtr->stdoutInitialized) {
|
||||
tsdPtr->stdoutInitialized = -1;
|
||||
tsdPtr->stdoutChannel = TclpGetDefaultStdChannel(TCL_STDOUT);
|
||||
tsdPtr->stdoutInitialized = 1;
|
||||
if (tsdPtr->stdoutChannel != NULL) {
|
||||
tsdPtr->stdoutInitialized = 1;
|
||||
Tcl_RegisterChannel(NULL, tsdPtr->stdoutChannel);
|
||||
}
|
||||
}
|
||||
@@ -791,10 +788,9 @@ Tcl_GetStdChannel(
|
||||
break;
|
||||
case TCL_STDERR:
|
||||
if (!tsdPtr->stderrInitialized) {
|
||||
tsdPtr->stderrInitialized = -1;
|
||||
tsdPtr->stderrChannel = TclpGetDefaultStdChannel(TCL_STDERR);
|
||||
tsdPtr->stderrInitialized = 1;
|
||||
if (tsdPtr->stderrChannel != NULL) {
|
||||
tsdPtr->stderrInitialized = 1;
|
||||
Tcl_RegisterChannel(NULL, tsdPtr->stderrChannel);
|
||||
}
|
||||
}
|
||||
@@ -1062,7 +1058,7 @@ CheckForStdChannelsBeingClosed(
|
||||
ChannelState *statePtr = ((Channel *) chan)->state;
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
|
||||
if (tsdPtr->stdinInitialized == 1
|
||||
if (tsdPtr->stdinInitialized
|
||||
&& tsdPtr->stdinChannel != NULL
|
||||
&& statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
|
||||
if (statePtr->refCount < 2) {
|
||||
@@ -1070,7 +1066,7 @@ CheckForStdChannelsBeingClosed(
|
||||
tsdPtr->stdinChannel = NULL;
|
||||
return;
|
||||
}
|
||||
} else if (tsdPtr->stdoutInitialized == 1
|
||||
} else if (tsdPtr->stdoutInitialized
|
||||
&& tsdPtr->stdoutChannel != NULL
|
||||
&& statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
|
||||
if (statePtr->refCount < 2) {
|
||||
@@ -1078,7 +1074,7 @@ CheckForStdChannelsBeingClosed(
|
||||
tsdPtr->stdoutChannel = NULL;
|
||||
return;
|
||||
}
|
||||
} else if (tsdPtr->stderrInitialized == 1
|
||||
} else if (tsdPtr->stderrInitialized
|
||||
&& tsdPtr->stderrChannel != NULL
|
||||
&& statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
|
||||
if (statePtr->refCount < 2) {
|
||||
|
||||
+26
-4
@@ -139,6 +139,7 @@ Tcl_FSRenameFileProc TclpObjRenameFile;
|
||||
Tcl_FSCreateDirectoryProc TclpObjCreateDirectory;
|
||||
Tcl_FSCopyDirectoryProc TclpObjCopyDirectory;
|
||||
Tcl_FSRemoveDirectoryProc TclpObjRemoveDirectory;
|
||||
Tcl_FSUnloadFileProc TclpUnloadFile;
|
||||
Tcl_FSLinkProc TclpObjLink;
|
||||
Tcl_FSListVolumesProc TclpObjListVolumes;
|
||||
|
||||
@@ -411,6 +412,7 @@ Tcl_GetCwd(
|
||||
return Tcl_DStringValue(cwdPtr);
|
||||
}
|
||||
|
||||
/* Obsolete */
|
||||
int
|
||||
Tcl_EvalFile(
|
||||
Tcl_Interp *interp, /* Interpreter in which to process file. */
|
||||
@@ -3158,8 +3160,8 @@ Tcl_FSLoadFile(
|
||||
* present and set to true (any integer > 0) then the unlink is skipped.
|
||||
*/
|
||||
|
||||
static int
|
||||
skipUnlink (Tcl_Obj* shlibFile)
|
||||
int
|
||||
TclSkipUnlink (Tcl_Obj* shlibFile)
|
||||
{
|
||||
/* Order of testing:
|
||||
* 1. On hpux we generally want to skip unlink in general
|
||||
@@ -3413,7 +3415,7 @@ Tcl_LoadFile(
|
||||
*/
|
||||
|
||||
if (
|
||||
!skipUnlink (copyToPtr) &&
|
||||
!TclSkipUnlink (copyToPtr) &&
|
||||
(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
|
||||
Tcl_DecrRefCount(copyToPtr);
|
||||
|
||||
@@ -3682,10 +3684,30 @@ Tcl_FSUnloadFile(
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
TclpUnloadFile(handle);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclpUnloadFile --
|
||||
*
|
||||
* Unloads a library given its handle
|
||||
*
|
||||
* This function was once filesystem-specific, but has been made portable by
|
||||
* having TclpDlopen return a structure that includes procedure pointers.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
TclpUnloadFile(
|
||||
Tcl_LoadHandle handle)
|
||||
{
|
||||
if (handle->unloadFileProcPtr != NULL) {
|
||||
handle->unloadFileProcPtr(handle);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
@@ -878,8 +878,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;
|
||||
|
||||
|
||||
@@ -1088,7 +1088,7 @@ declare 9 win {
|
||||
}
|
||||
# new for 8.4.20+/8.5.12+ Cygwin only
|
||||
declare 10 win {
|
||||
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
|
||||
Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
}
|
||||
# Removed in 8.3.1 (for Win32s only)
|
||||
#declare 10 win {
|
||||
@@ -1226,7 +1226,7 @@ declare 9 unix {
|
||||
# Added in 8.4:
|
||||
|
||||
declare 10 unix {
|
||||
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
|
||||
Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
}
|
||||
# Slots 11 and 12 are forwarders for functions that were promoted to
|
||||
# generic Stubs
|
||||
|
||||
+21
-89
@@ -413,7 +413,7 @@ 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
|
||||
@@ -902,8 +902,9 @@ typedef struct CompiledLocal {
|
||||
/* Next compiler-recognized local variable for
|
||||
* this procedure, or NULL if this is the last
|
||||
* local. */
|
||||
int nameLength; /* The number of bytes in local variable's name.
|
||||
* Among others used to speed up var lookups. */
|
||||
int nameLength; /* The number of characters in local
|
||||
* variable's name. Used to speed up variable
|
||||
* lookups. */
|
||||
int frameIndex; /* Index in the array of compiler-assigned
|
||||
* variables in the procedure call frame. */
|
||||
int flags; /* Flag bits for the local variable. Same as
|
||||
@@ -1812,7 +1813,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;
|
||||
|
||||
/*
|
||||
@@ -2227,7 +2228,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.
|
||||
@@ -2368,7 +2369,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 \
|
||||
@@ -2421,8 +2422,8 @@ typedef struct List {
|
||||
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
|
||||
|
||||
/*
|
||||
* Macros providing a faster path to integers: 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.
|
||||
*/
|
||||
@@ -2443,17 +2444,9 @@ typedef struct List {
|
||||
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
|
||||
#else
|
||||
#define TclGetIntFromObj(interp, objPtr, intPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
&& (objPtr)->internalRep.longValue >= -(Tcl_WideInt)(UINT_MAX) \
|
||||
&& (objPtr)->internalRep.longValue <= (Tcl_WideInt)(UINT_MAX)) \
|
||||
? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
|
||||
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
|
||||
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
&& (objPtr)->internalRep.longValue >= INT_MIN \
|
||||
&& (objPtr)->internalRep.longValue <= INT_MAX) \
|
||||
? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
|
||||
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
|
||||
Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
|
||||
#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr) \
|
||||
TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
|
||||
#endif
|
||||
|
||||
/*
|
||||
@@ -2490,13 +2483,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
|
||||
@@ -2734,10 +2727,6 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
|
||||
MODULE_SCOPE char * tclEmptyStringRep;
|
||||
MODULE_SCOPE char tclEmptyString;
|
||||
|
||||
enum CheckEmptyStringResult {
|
||||
TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
|
||||
};
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* Procedures shared among Tcl modules but not used by the outside world,
|
||||
@@ -2753,7 +2742,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;
|
||||
@@ -2867,6 +2855,8 @@ MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp,
|
||||
CmdFrame *cfPtr);
|
||||
MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
|
||||
CmdFrame **cfPtrPtr, int *wordPtr);
|
||||
MODULE_SCOPE int TclArraySet(Tcl_Interp *interp,
|
||||
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
|
||||
MODULE_SCOPE double TclBignumToDouble(const mp_int *bignum);
|
||||
MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
int strLen, const unsigned char *pattern,
|
||||
@@ -2874,11 +2864,8 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
|
||||
MODULE_SCOPE double TclCeil(const mp_int *a);
|
||||
MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
|
||||
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
|
||||
MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
|
||||
Var *arrayPtr, Tcl_Obj *name, int index);
|
||||
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
|
||||
const char *value);
|
||||
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
|
||||
@@ -2892,19 +2879,6 @@ 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,
|
||||
@@ -2933,10 +2907,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);
|
||||
@@ -2962,15 +2932,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);
|
||||
@@ -3024,10 +2985,9 @@ MODULE_SCOPE void TclInitNotifier(void);
|
||||
MODULE_SCOPE void TclInitObjSubsystem(void);
|
||||
MODULE_SCOPE void TclInitSubsystems(void);
|
||||
MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int TclIsSpaceProc(int byte);
|
||||
MODULE_SCOPE int TclIsBareword(int byte);
|
||||
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[],
|
||||
int forceRelative);
|
||||
MODULE_SCOPE int TclIsSpaceProc(char byte);
|
||||
MODULE_SCOPE int TclIsBareword(char byte);
|
||||
MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]);
|
||||
MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result);
|
||||
MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp);
|
||||
MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp,
|
||||
@@ -3138,7 +3098,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,
|
||||
@@ -3155,12 +3115,6 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
|
||||
Tcl_Obj *bad, Tcl_Obj *fix);
|
||||
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
|
||||
int numBytes);
|
||||
|
||||
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
|
||||
MODULE_SCOPE int TclStringCmp (Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
|
||||
int checkEq, int nocase, int reqlength);
|
||||
MODULE_SCOPE int TclStringCmpOpts (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
|
||||
int *nocase, int *reqlength);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
|
||||
const char *pattern, int ptnLen, int flags);
|
||||
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
|
||||
@@ -3177,8 +3131,6 @@ 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,
|
||||
@@ -4023,21 +3975,6 @@ MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
|
||||
|
||||
MODULE_SCOPE int TclFullFinalizationRequested(void);
|
||||
|
||||
/*
|
||||
* 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.
|
||||
@@ -4466,11 +4403,6 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
|
||||
#define TclIsPureByteArray(objPtr) \
|
||||
(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
|
||||
#define TclIsPureDict(objPtr) \
|
||||
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
|
||||
|
||||
#define TclIsPureList(objPtr) \
|
||||
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -4492,7 +4424,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
* 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);
|
||||
|
||||
@@ -15,6 +15,7 @@
|
||||
#ifndef _TCLINTDECLS
|
||||
#define _TCLINTDECLS
|
||||
|
||||
#include "tclPort.h"
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_tcl
|
||||
|
||||
@@ -13,6 +13,11 @@
|
||||
#ifndef _TCLINTPLATDECLS
|
||||
#define _TCLINTPLATDECLS
|
||||
|
||||
#ifdef _WIN32
|
||||
# define Tcl_DirEntry void
|
||||
# define DIR void
|
||||
#endif
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_tcl
|
||||
# define TCL_STORAGE_CLASS DLLEXPORT
|
||||
@@ -67,7 +72,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
@@ -124,7 +129,7 @@ EXTERN int TclpGetPid(Tcl_Pid pid);
|
||||
/* 9 */
|
||||
EXTERN int TclWinGetPlatformId(void);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
@@ -201,7 +206,7 @@ EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
@@ -264,7 +269,7 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
@@ -297,7 +302,7 @@ typedef struct TclIntPlatStubs {
|
||||
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
|
||||
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
|
||||
int (*tclWinGetPlatformId) (void); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 12 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
|
||||
@@ -330,7 +335,7 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
|
||||
+1
-1
@@ -638,7 +638,7 @@ static Tcl_ObjType invalidRealType = {
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
NULL /* setFromAnyProc */
|
||||
SetInvalidRealFromAny /* setFromAnyProc */
|
||||
};
|
||||
|
||||
static int
|
||||
|
||||
+311
-303
@@ -55,22 +55,20 @@ const Tcl_ObjType tclListType = {
|
||||
*
|
||||
* NewListIntRep --
|
||||
*
|
||||
* Creates a 'List' structure with space for 'objc' elements. 'objc' must
|
||||
* be > 0. If 'objv' is not NULL, The list is initialized with first
|
||||
* 'objc' values in that array. Otherwise the list is initialized to have
|
||||
* 0 elements, with space to add 'objc' more. Flag value 'p' indicates
|
||||
* Creates a list internal rep with space for objc elements. objc
|
||||
* must be > 0. If objv!=NULL, initializes with the first objc values
|
||||
* in that array. If objv==NULL, initalize list internal rep to have
|
||||
* 0 elements, with space to add objc more. Flag value "p" indicates
|
||||
* how to behave on failure.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* A new List struct with refCount 0 is returned. If some failure
|
||||
* prevents this then if p=0, NULL is returned and otherwise the
|
||||
* routine panics.
|
||||
*
|
||||
* A new 'List' structure with refCount 0. If some failure
|
||||
* prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
|
||||
* is called if it is not.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The refCount of each value in 'objv' is incremented as it is added
|
||||
* to the list.
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -134,10 +132,22 @@ NewListIntRep(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* AttemptNewList --
|
||||
* AttemptNewList --
|
||||
*
|
||||
* Creates a list internal rep with space for objc elements. objc
|
||||
* must be > 0. If objv!=NULL, initializes with the first objc values
|
||||
* in that array. If objv==NULL, initalize list internal rep to have
|
||||
* 0 elements, with space to add objc more.
|
||||
*
|
||||
* Results:
|
||||
* A new List struct with refCount 0 is returned. If some failure
|
||||
* prevents this then NULL is returned, and an error message is left
|
||||
* in the interp result, unless interp is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
* Like NewListIntRep, but additionally sets an error message on failure.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
@@ -169,20 +179,23 @@ AttemptNewList(
|
||||
*
|
||||
* Tcl_NewListObj --
|
||||
*
|
||||
* Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
|
||||
* defined, 'Tcl_DbNewListObj' is called instead.
|
||||
* This function is normally called when not debugging: i.e., when
|
||||
* TCL_MEM_DEBUG is not defined. It creates a new list object from an
|
||||
* (objc,objv) array: that is, each of the objc elements of the array
|
||||
* referenced by objv is inserted as an element into a new Tcl object.
|
||||
*
|
||||
* Value
|
||||
* When TCL_MEM_DEBUG is defined, this function just returns the result
|
||||
* of calling the debugging version Tcl_DbNewListObj.
|
||||
*
|
||||
* A new list 'Tcl_Obj' to which is appended values from 'objv', or if
|
||||
* 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
|
||||
* elements. The string representation of the new 'Tcl_Obj' is set to
|
||||
* NULL. The refCount of the list is 0.
|
||||
* Results:
|
||||
* A new list object is returned that is initialized from the object
|
||||
* pointers in objv. If objc is less than or equal to zero, an empty
|
||||
* object is returned. The new object's string representation is left
|
||||
* NULL. The resulting new list object has ref count 0.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The refCount of each elements in 'objv' is incremented as it is added
|
||||
* to the list.
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -233,14 +246,28 @@ Tcl_NewListObj(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_DbNewListObj --
|
||||
*
|
||||
* Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
|
||||
* file name and line number from its caller. This simplifies debugging
|
||||
* since the [memory active] command will report the correct file
|
||||
* name and line number when reporting objects that haven't been freed.
|
||||
*
|
||||
* When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
|
||||
* Tcl_DbNewListObj --
|
||||
*
|
||||
* This function is normally called when debugging: i.e., when
|
||||
* TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
|
||||
* as the Tcl_NewListObj function above except that it calls
|
||||
* Tcl_DbCkalloc directly with the file name and line number from its
|
||||
* caller. This simplifies debugging since then the [memory active]
|
||||
* command will report the correct file name and line number when
|
||||
* reporting objects that haven't been freed.
|
||||
*
|
||||
* When TCL_MEM_DEBUG is not defined, this function just returns the
|
||||
* result of calling Tcl_NewListObj.
|
||||
*
|
||||
* Results:
|
||||
* A new list object is returned that is initialized from the object
|
||||
* pointers in objv. If objc is less than or equal to zero, an empty
|
||||
* object is returned. The new object's string representation is left
|
||||
* NULL. The new list object has ref count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -301,8 +328,19 @@ Tcl_DbNewListObj(
|
||||
*
|
||||
* Tcl_SetListObj --
|
||||
*
|
||||
* Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
|
||||
* creating a new one.
|
||||
* Modify an object to be a list containing each of the objc elements of
|
||||
* the object array referenced by objv.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object is made a list object and is initialized from the object
|
||||
* pointers in objv. If objc is less than or equal to zero, an empty
|
||||
* object is returned. The new object's string representation is left
|
||||
* NULL. The ref counts of the elements in objv are incremented since the
|
||||
* list now refers to them. The object's old string and internal
|
||||
* representations are freed and its type is set NULL.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -346,20 +384,18 @@ Tcl_SetListObj(
|
||||
*
|
||||
* TclListObjCopy --
|
||||
*
|
||||
* Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
|
||||
* provides for the C level a counterpart of the [lrange $list 0 end]
|
||||
* command, while using internals details to be as efficient as possible.
|
||||
* Makes a "pure list" copy of a list value. This provides for the C
|
||||
* level a counterpart of the [lrange $list 0 end] command, while using
|
||||
* internals details to be as efficient as possible.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* Normally returns a pointer to a new Tcl_Obj, that contains the same
|
||||
* list value as *listPtr does. The returned Tcl_Obj has a refCount of
|
||||
* zero. If *listPtr does not hold a list, NULL is returned, and if
|
||||
* interp is non-NULL, an error message is recorded there.
|
||||
*
|
||||
* The address of the new 'Tcl_Obj' which shares its internal
|
||||
* representation with 'listPtr', and whose refCount is 0. If 'listPtr'
|
||||
* is not actually a list, the value is NULL, and an error message is left
|
||||
* in 'interp' if it is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* 'listPtr' is converted to a list if it isn't one already.
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -389,30 +425,27 @@ TclListObjCopy(
|
||||
*
|
||||
* Tcl_ListObjGetElements --
|
||||
*
|
||||
* Retreive the elements in a list 'Tcl_Obj'.
|
||||
* This function returns an (objc,objv) array of the elements in a list
|
||||
* object.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case *objcPtr is set to
|
||||
* the count of list elements and *objvPtr is set to a pointer to an
|
||||
* array of (*objcPtr) pointers to each list element. If listPtr does not
|
||||
* refer to a list object and the object can not be converted to one,
|
||||
* TCL_ERROR is returned and an error message will be left in the
|
||||
* interpreter's result if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
* The objects referenced by the returned array should be treated as
|
||||
* readonly and their ref counts are _not_ incremented; the caller must
|
||||
* do that if it holds on to a reference. Furthermore, the pointer and
|
||||
* length returned by this function may change as soon as any function is
|
||||
* called on the list object; be careful about retaining the pointer in a
|
||||
* local data structure.
|
||||
*
|
||||
* A count of list elements is stored, 'objcPtr', And a pointer to the
|
||||
* array of elements in the list is stored in 'objvPtr'.
|
||||
*
|
||||
* The elements accessible via 'objvPtr' should be treated as readonly
|
||||
* and the refCount for each object is _not_ incremented; the caller
|
||||
* must do that if it holds on to a reference. Furthermore, the
|
||||
* pointer and length returned by this function may change as soon as
|
||||
* any function is called on the list object. Be careful about
|
||||
* retaining the pointer in a local data structure.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* 'listPtr' is converted to a list object if it isn't one already.
|
||||
* Side effects:
|
||||
* The possible conversion of the object referenced by listPtr
|
||||
* to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -453,27 +486,20 @@ Tcl_ListObjGetElements(
|
||||
*
|
||||
* Tcl_ListObjAppendList --
|
||||
*
|
||||
* Appends the elements of elemListPtr to those of listPtr.
|
||||
* This function appends the elements in the list value referenced by
|
||||
* elemListPtr to the list value referenced by listPtr.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK. If listPtr or elemListPtr do not
|
||||
* refer to list values, TCL_ERROR is returned and an error message is
|
||||
* left in the interpreter's result if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* Success.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' or 'elemListPtr' are not valid lists. An error
|
||||
* message is left in the interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The reference count of each element of 'elemListPtr' as it is added to
|
||||
* 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
|
||||
* if they are not already. Appending the new elements may cause the
|
||||
* array of element pointers in 'listObj' to grow. If any objects are
|
||||
* appended to 'listPtr'. Any preexisting string representation of
|
||||
* 'listPtr' is invalidated.
|
||||
* Side effects:
|
||||
* The reference counts of the elements in elemListPtr are incremented
|
||||
* since the list now refers to them. listPtr and elemListPtr are
|
||||
* converted, if necessary, to list objects. Also, appending the new
|
||||
* elements may cause listObj's array of element pointers to grow.
|
||||
* listPtr's old string representation, if any, is invalidated.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -512,27 +538,24 @@ Tcl_ListObjAppendList(
|
||||
*
|
||||
* Tcl_ListObjAppendElement --
|
||||
*
|
||||
* Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
|
||||
* This function is a special purpose version of Tcl_ListObjAppendList:
|
||||
* it appends a single object referenced by objPtr to the list object
|
||||
* referenced by listPtr. If listPtr is not already a list object, an
|
||||
* attempt will be made to convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case objPtr is added to
|
||||
* the end of listPtr's list. If listPtr does not refer to a list object
|
||||
* and the object can not be converted to one, TCL_ERROR is returned and
|
||||
* an error message will be left in the interpreter's result if interp is
|
||||
* not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* 'objPtr' is appended to the elements of 'listPtr'.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* listPtr does not refer to a list object and the object can not be
|
||||
* converted to one. An error message will be left in the
|
||||
* interpreter's result if interp is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' is not already of type 'tclListType', it is converted.
|
||||
* The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
|
||||
* Appending the new element may cause the the array of element pointers
|
||||
* in 'listObj' to grow. Any preexisting string representation of
|
||||
* 'listPtr' is invalidated.
|
||||
* Side effects:
|
||||
* The ref count of objPtr is incremented since the list now refers to
|
||||
* it. listPtr will be converted, if necessary, to a list object. Also,
|
||||
* appending the new element may cause listObj's array of element
|
||||
* pointers to grow. listPtr's old string representation, if any, is
|
||||
* invalidated.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -683,27 +706,23 @@ Tcl_ListObjAppendElement(
|
||||
*
|
||||
* Tcl_ListObjIndex --
|
||||
*
|
||||
* Retrieve a pointer to the element of 'listPtr' at 'index'. The index
|
||||
* of the first element is 0.
|
||||
* This function returns a pointer to the index'th object from the list
|
||||
* referenced by listPtr. The first element has index 0. If index is
|
||||
* negative or greater than or equal to the number of elements in the
|
||||
* list, a NULL is returned. If listPtr is not a list object, an attempt
|
||||
* will be made to convert it to a list.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case objPtrPtr is set to
|
||||
* the Tcl_Obj pointer for the index'th list element or NULL if index is
|
||||
* out of range. This object should be treated as readonly and its ref
|
||||
* count is _not_ incremented; the caller must do that if it holds on to
|
||||
* the reference. If listPtr does not refer to a list and can't be
|
||||
* converted to one, TCL_ERROR is returned and an error message is left
|
||||
* in the interpreter's result if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* A pointer to the element at 'index' is stored in 'objPtrPtr'. If
|
||||
* 'index' is out of range, NULL is stored in 'objPtrPtr'. This
|
||||
* object should be treated as readonly and its 'refCount' is _not_
|
||||
* incremented. The caller must do that if it holds on to the
|
||||
* reference.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An an error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' is not already of type 'tclListType', it is converted.
|
||||
* Side effects:
|
||||
* listPtr will be converted, if necessary, to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -745,20 +764,19 @@ Tcl_ListObjIndex(
|
||||
*
|
||||
* Tcl_ListObjLength --
|
||||
*
|
||||
* Retrieve the number of elements in a list.
|
||||
* This function returns the number of elements in a list object. If the
|
||||
* object is not already a list object, an attempt will be made to
|
||||
* convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case *intPtr will be set
|
||||
* to the integer count of list elements. If listPtr does not refer to a
|
||||
* list object and the object can not be converted to one, TCL_ERROR is
|
||||
* returned and an error message will be left in the interpreter's result
|
||||
* if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* A count of list elements is stored at the address provided by
|
||||
* 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
|
||||
* converted.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An error message will be left in
|
||||
* the interpreter's result if 'interp' is not NULL.
|
||||
* Side effects:
|
||||
* The possible conversion of the argument object to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -794,36 +812,35 @@ Tcl_ListObjLength(
|
||||
*
|
||||
* Tcl_ListObjReplace --
|
||||
*
|
||||
* Replace values in a list.
|
||||
* This function replaces zero or more elements of the list referenced by
|
||||
* listPtr with the objects from an (objc,objv) array. The objc elements
|
||||
* of the array referenced by objv replace the count elements in listPtr
|
||||
* starting at first.
|
||||
*
|
||||
* If 'first' is zero or negative, it refers to the first element. If
|
||||
* 'first' outside the range of elements in the list, no elements are
|
||||
* deleted.
|
||||
* If the argument first is zero or negative, it refers to the first
|
||||
* element. If first is greater than or equal to the number of elements
|
||||
* in the list, then no elements are deleted; the new elements are
|
||||
* appended to the list. Count gives the number of elements to replace.
|
||||
* If count is zero or negative then no elements are deleted; the new
|
||||
* elements are simply inserted before first.
|
||||
*
|
||||
* If 'count' is zero or negative no elements are deleted, and any new
|
||||
* elements are inserted at the beginning of the list.
|
||||
* The argument objv refers to an array of objc pointers to the new
|
||||
* elements to be added to listPtr in place of those that were deleted.
|
||||
* If objv is NULL, no new elements are added. If listPtr is not a list
|
||||
* object, an attempt will be made to convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK. If listPtr does not refer to a
|
||||
* list object and can not be converted to one, TCL_ERROR is returned and
|
||||
* an error message will be left in the interpreter's result if interp is
|
||||
* not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
|
||||
* starting at 'first'. If 'objc' 0, no new elements are added.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' is not of type 'tclListType', it is converted if possible.
|
||||
*
|
||||
* The 'refCount' of each element appended to the list is incremented.
|
||||
* Similarly, the 'refCount' for each replaced element is decremented.
|
||||
*
|
||||
* If 'listPtr' is modified, any previous string representation is
|
||||
* invalidated.
|
||||
* Side effects:
|
||||
* The ref counts of the objc elements in objv are incremented since the
|
||||
* resulting list now refers to them. Similarly, the ref counts for
|
||||
* replaced objects are decremented. listPtr is converted, if necessary,
|
||||
* to a list object. listPtr's old string representation, if any, is
|
||||
* freed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1081,19 +1098,22 @@ Tcl_ListObjReplace(
|
||||
*
|
||||
* TclLindexList --
|
||||
*
|
||||
* Implements the 'lindex' command when objc==3.
|
||||
* This procedure handles the 'lindex' command when objc==3.
|
||||
*
|
||||
* Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
|
||||
* the argument format into required form while taking care to manage
|
||||
* shimmering so as to tend to keep the most useful intreps
|
||||
* and/or avoid the most expensive conversions.
|
||||
* Results:
|
||||
* Returns a pointer to the object extracted, or NULL if an error
|
||||
* occurred. The returned object already includes one reference count for
|
||||
* the pointer returned.
|
||||
*
|
||||
* Value
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
* A pointer to the specified element, with its 'refCount' incremented, or
|
||||
* NULL if an error occurred.
|
||||
*
|
||||
* Notes
|
||||
* Notes:
|
||||
* This procedure is implemented entirely as a wrapper around
|
||||
* TclLindexFlat. All it does is reconfigure the argument format into the
|
||||
* form required by TclLindexFlat, while taking care to manage shimmering
|
||||
* in such a way that we tend to keep the most useful intreps and/or
|
||||
* avoid the most expensive conversions.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1145,11 +1165,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);
|
||||
@@ -1159,20 +1185,25 @@ TclLindexList(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclLindexFlat --
|
||||
* TclLindexFlat --
|
||||
*
|
||||
* The core of the 'lindex' command, with all index
|
||||
* arguments presented as a flat list.
|
||||
* This procedure is the core of the 'lindex' command, with all index
|
||||
* arguments presented as a flat list.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* Returns a pointer to the object extracted, or NULL if an error
|
||||
* occurred. The returned object already includes one reference count for
|
||||
* the pointer returned.
|
||||
*
|
||||
* A pointer to the object extracted, with its 'refCount' incremented, or
|
||||
* NULL if an error occurred. Thus, the calling code will usually do
|
||||
* something like:
|
||||
*
|
||||
* Tcl_SetObjResult(interp, result);
|
||||
* Tcl_DecrRefCount(result);
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
* Notes:
|
||||
* The reference count of the returned object includes one reference
|
||||
* corresponding to the pointer returned. Thus, the calling code will
|
||||
* usually do something like:
|
||||
* Tcl_SetObjResult(interp, result);
|
||||
* Tcl_DecrRefCount(result);
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1248,16 +1279,23 @@ TclLindexFlat(
|
||||
*
|
||||
* TclLsetList --
|
||||
*
|
||||
* The core of [lset] when objc == 4. Objv[2] may be either a
|
||||
* Core of the 'lset' command when objc == 4. Objv[2] may be either a
|
||||
* scalar index or a list of indices.
|
||||
*
|
||||
* Implemented entirely as a wrapper around 'TclLindexFlat', as described
|
||||
* for 'TclLindexList'.
|
||||
* Results:
|
||||
* Returns the new value of the list variable, or NULL if there was an
|
||||
* error. The returned object includes one reference count for the
|
||||
* pointer returned.
|
||||
*
|
||||
* Value
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
* The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
|
||||
* there was an error.
|
||||
* Notes:
|
||||
* This procedure is implemented entirely as a wrapper around
|
||||
* TclLsetFlat. All it does is reconfigure the argument format into the
|
||||
* form required by TclLsetFlat, while taking care to manage shimmering
|
||||
* in such a way that we tend to keep the most useful intreps and/or
|
||||
* avoid the most expensive conversions.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1319,39 +1357,36 @@ TclLsetList(
|
||||
*
|
||||
* Core engine of the 'lset' command.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* Returns the new value of the list variable, or NULL if an error
|
||||
* occurred. The returned object includes one reference count for the
|
||||
* pointer returned.
|
||||
*
|
||||
* The resulting list
|
||||
* Side effects:
|
||||
* On entry, the reference count of the variable value does not reflect
|
||||
* any references held on the stack. The first action of this function is
|
||||
* to determine whether the object is shared, and to duplicate it if it
|
||||
* is. The reference count of the duplicate is incremented. At this
|
||||
* point, the reference count will be 1 for either case, so that the
|
||||
* object will appear to be unshared.
|
||||
*
|
||||
* The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not
|
||||
* duplicated, its 'refCount' is incremented. The reference count of
|
||||
* an unduplicated object is therefore 2 (one for the returned pointer
|
||||
* and one for the variable that holds it). The reference count of a
|
||||
* duplicate object is 1, reflecting that result is the only active
|
||||
* reference. The caller is expected to store the result in the
|
||||
* variable and decrement its reference count. (INST_STORE_* does
|
||||
* exactly this.)
|
||||
*
|
||||
* NULL
|
||||
*
|
||||
* An error occurred. If 'listPtr' was duplicated, the reference
|
||||
* count on the duplicate is decremented so that it is 0, causing any
|
||||
* memory allocated by this function to be freed.
|
||||
* If an error occurs, and the object has been duplicated, the reference
|
||||
* count on the duplicate is decremented so that it is now 0: this
|
||||
* dismisses any memory that was allocated by this function.
|
||||
*
|
||||
* If no error occurs, the reference count of the original object is
|
||||
* incremented if the object has not been duplicated, and nothing is done
|
||||
* to a reference count of the duplicate. Now the reference count of an
|
||||
* unduplicated object is 2 (the returned pointer, plus the one stored in
|
||||
* the variable). The reference count of a duplicate object is 1,
|
||||
* reflecting that the returned pointer is the only active reference. The
|
||||
* caller is expected to store the returned value back in the variable
|
||||
* and decrement its reference count. (INST_STORE_* does exactly this.)
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* On entry, the reference count of 'listPtr' does not reflect any
|
||||
* references held on the stack. The first action of this function is to
|
||||
* determine whether 'listPtr' is shared and to create a duplicate
|
||||
* unshared copy if it is. The reference count of the duplicate is
|
||||
* incremented. At this point, the reference count is 1 in either case so
|
||||
* that the object is considered unshared.
|
||||
*
|
||||
* The unshared list is altered directly to produce the result.
|
||||
* 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
|
||||
* Surgery is performed on the unshared list value to produce the result.
|
||||
* TclLsetFlat maintains a linked list of Tcl_Obj's whose string
|
||||
* representations must be spoilt by threading via 'ptr2' of the
|
||||
* two-pointer internal representation. On entry to 'TclLsetFlat', the
|
||||
* two-pointer internal representation. On entry to TclLsetFlat, the
|
||||
* values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
|
||||
* Tcl_Obj that has been modified is set to NULL.
|
||||
*
|
||||
@@ -1566,38 +1601,26 @@ TclLsetFlat(
|
||||
*
|
||||
* TclListObjSetElement --
|
||||
*
|
||||
* Set a single element of a list to a specified value.
|
||||
* Set a single element of a list to a specified value
|
||||
*
|
||||
* Results:
|
||||
* The return value is normally TCL_OK. If listPtr does not refer to a
|
||||
* list object and cannot be converted to one, TCL_ERROR is returned and
|
||||
* an error message will be left in the interpreter result if interp is
|
||||
* not NULL. Similarly, if index designates an element outside the range
|
||||
* [0..listLength-1], where listLength is the count of elements in the
|
||||
* list object designated by listPtr, TCL_ERROR is returned and an error
|
||||
* message is left in the interpreter result.
|
||||
*
|
||||
* Side effects:
|
||||
* Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
|
||||
* to convert it to a list with a non-shared internal rep. Decrements the
|
||||
* ref count of the object at the specified index within the list,
|
||||
* replaces with the object designated by valuePtr, and increments the
|
||||
* ref count of the replacement object.
|
||||
*
|
||||
* It is the caller's responsibility to invalidate the string
|
||||
* representation of the 'listPtr'.
|
||||
*
|
||||
* Value
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* Success.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' does not refer to a list object and cannot be converted
|
||||
* to one. An error message will be left in the interpreter result if
|
||||
* interp is not NULL.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* An index designates an element outside the range [0..listLength-1],
|
||||
* where 'listLength' is the count of elements in the list object
|
||||
* designated by 'listPtr'. An error message is left in the
|
||||
* interpreter result.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If
|
||||
* 'listPtr' is not already of type 'tclListType', it is converted and the
|
||||
* internal representation is unshared. The 'refCount' of the element at
|
||||
* 'index' is decremented and replaced in the list with the 'valuePtr',
|
||||
* whose 'refCount' in turn is incremented.
|
||||
*
|
||||
* representation of the object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1715,14 +1738,16 @@ TclListObjSetElement(
|
||||
*
|
||||
* FreeListInternalRep --
|
||||
*
|
||||
* Deallocate the storage associated with the internal representation of a
|
||||
* a list object.
|
||||
* Deallocate the storage associated with a list object's internal
|
||||
* representation.
|
||||
*
|
||||
* Effect
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* The storage for the internal 'List' pointer of 'listPtr' is freed, the
|
||||
* 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount'
|
||||
* of each element of the list is decremented.
|
||||
* Side effects:
|
||||
* Frees listPtr's List* internal representation and sets listPtr's
|
||||
* internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
|
||||
* element objects, which may free them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1751,12 +1776,14 @@ FreeListInternalRep(
|
||||
*
|
||||
* DupListInternalRep --
|
||||
*
|
||||
* Initialize the internal representation of a list 'Tcl_Obj' to share the
|
||||
* Initialize the internal representation of a list Tcl_Obj to share the
|
||||
* internal representation of an existing list object.
|
||||
*
|
||||
* Effect
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* The 'refCount' of the List internal rep is incremented.
|
||||
* Side effects:
|
||||
* The reference count of the List internal rep is incremented.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1776,20 +1803,16 @@ DupListInternalRep(
|
||||
*
|
||||
* SetListFromAny --
|
||||
*
|
||||
* Convert any object to a list.
|
||||
* Attempt to generate a list internal form for the Tcl object "objPtr".
|
||||
*
|
||||
* Value
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* Success. The internal representation of 'objPtr' is set, and the type
|
||||
* of 'objPtr' is 'tclListType'.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* An error occured during conversion. An error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
* Results:
|
||||
* The return value is TCL_OK or TCL_ERROR. If an error occurs during
|
||||
* conversion, an error message is left in the interpreter's result
|
||||
* unless "interp" is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
* If no error occurs, a list is stored as "objPtr"s internal
|
||||
* representation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1914,16 +1937,18 @@ SetListFromAny(
|
||||
*
|
||||
* UpdateStringOfList --
|
||||
*
|
||||
* Update the string representation for a list object.
|
||||
* Update the string representation for a list object. Note: This
|
||||
* function does not invalidate an existing old string rep so storage
|
||||
* will be lost if this has not already been done.
|
||||
*
|
||||
* Any previously-exising string representation is not invalidated, so
|
||||
* storage is lost if this has not been taken care of.
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The string representation of 'listPtr' is set to the resulting string.
|
||||
* This string will be empty if the list has no elements. It is assumed
|
||||
* that the list internal representation is not NULL.
|
||||
* Side effects:
|
||||
* The object's string is set to a valid string that results from the
|
||||
* list-to-string conversion. This string will be empty if the list has
|
||||
* no elements. The list internal representation should not be NULL and
|
||||
* we assume it is not NULL.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1932,8 +1957,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;
|
||||
@@ -1970,7 +1995,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++) {
|
||||
@@ -1990,21 +2015,7 @@ UpdateStringOfList(
|
||||
* Pass 2: copy into string rep buffer.
|
||||
*/
|
||||
|
||||
/*
|
||||
* We used to set the string length here, relying on a presumed
|
||||
* guarantee that the number of bytes TclScanElement() calls reported
|
||||
* to be needed was a precise count and not an over-estimate, so long
|
||||
* as the same flag values were passed to TclConvertElement().
|
||||
*
|
||||
* Then we saw [35a8f1c04a], where a bug in TclScanElement() caused
|
||||
* that guarantee to fail. Rather than trust there are no more bugs,
|
||||
* we set the length after the loop based on what was actually written,
|
||||
* an not on what was predicted.
|
||||
*
|
||||
listPtr->length = bytesNeeded - 1;
|
||||
*
|
||||
*/
|
||||
|
||||
listPtr->bytes = ckalloc(bytesNeeded);
|
||||
dst = listPtr->bytes;
|
||||
for (i = 0; i < numElems; i++) {
|
||||
@@ -2013,10 +2024,7 @@ UpdateStringOfList(
|
||||
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
|
||||
*dst++ = ' ';
|
||||
}
|
||||
dst[-1] = '\0';
|
||||
|
||||
/* Here is the safe setting of the string length. */
|
||||
listPtr->length = dst - 1 - listPtr->bytes;
|
||||
listPtr->bytes[listPtr->length] = '\0';
|
||||
|
||||
if (flagPtr != localFlags) {
|
||||
ckfree(flagPtr);
|
||||
|
||||
+15
-26
@@ -200,36 +200,25 @@ TclCreateLiteral(
|
||||
for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
|
||||
globalPtr = globalPtr->nextPtr) {
|
||||
objPtr = globalPtr->objPtr;
|
||||
if (globalPtr->nsPtr == nsPtr) {
|
||||
if ((globalPtr->nsPtr == nsPtr)
|
||||
&& (objPtr->length == length) && ((length == 0)
|
||||
|| ((objPtr->bytes[0] == bytes[0])
|
||||
&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
|
||||
/*
|
||||
* Literals should always have UTF-8 representations... but this
|
||||
* is not guaranteed so we need to be careful anyway.
|
||||
*
|
||||
* https://stackoverflow.com/q/54337750/301832
|
||||
* A literal was found: return it
|
||||
*/
|
||||
|
||||
int objLength;
|
||||
char *objBytes = TclGetStringFromObj(objPtr, &objLength);
|
||||
|
||||
if ((objLength == length) && ((length == 0)
|
||||
|| ((objBytes[0] == bytes[0])
|
||||
&& (memcmp(objBytes, bytes, (unsigned) length) == 0)))) {
|
||||
/*
|
||||
* A literal was found: return it
|
||||
*/
|
||||
|
||||
if (newPtr) {
|
||||
*newPtr = 0;
|
||||
}
|
||||
if (globalPtrPtr) {
|
||||
*globalPtrPtr = globalPtr;
|
||||
}
|
||||
if (flags & LITERAL_ON_HEAP) {
|
||||
ckfree(bytes);
|
||||
}
|
||||
globalPtr->refCount++;
|
||||
return objPtr;
|
||||
if (newPtr) {
|
||||
*newPtr = 0;
|
||||
}
|
||||
if (globalPtrPtr) {
|
||||
*globalPtrPtr = globalPtr;
|
||||
}
|
||||
if ((flags & LITERAL_ON_HEAP)) {
|
||||
ckfree(bytes);
|
||||
}
|
||||
globalPtr->refCount++;
|
||||
return objPtr;
|
||||
}
|
||||
}
|
||||
if (!newPtr) {
|
||||
|
||||
+11
-37
@@ -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);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2419,35 +2422,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);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -2665,7 +2639,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);
|
||||
|
||||
/*
|
||||
|
||||
+610
-543
File diff suppressed because it is too large
Load Diff
@@ -1206,10 +1206,22 @@ TclOOCopyObjectCmd(
|
||||
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
|
||||
} else {
|
||||
const char *name, *namespaceName;
|
||||
Tcl_DString buffer;
|
||||
|
||||
name = TclGetString(objv[2]);
|
||||
Tcl_DStringInit(&buffer);
|
||||
if (name[0] == '\0') {
|
||||
name = NULL;
|
||||
} else if (name[0]!=':' || name[1]!=':') {
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (iPtr->varFramePtr != NULL) {
|
||||
Tcl_DStringAppend(&buffer,
|
||||
iPtr->varFramePtr->nsPtr->fullName, -1);
|
||||
}
|
||||
TclDStringAppendLiteral(&buffer, "::");
|
||||
Tcl_DStringAppend(&buffer, name, -1);
|
||||
name = Tcl_DStringValue(&buffer);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1231,6 +1243,7 @@ TclOOCopyObjectCmd(
|
||||
}
|
||||
|
||||
o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
|
||||
Tcl_DStringFree(&buffer);
|
||||
}
|
||||
|
||||
if (o2Ptr == NULL) {
|
||||
|
||||
+6
-7
@@ -110,8 +110,7 @@ TclOODeleteContext(
|
||||
TclOODeleteChain(contextPtr->callPtr);
|
||||
if (oPtr != NULL) {
|
||||
TclStackFree(oPtr->fPtr->interp, contextPtr);
|
||||
/* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -234,7 +233,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.
|
||||
*
|
||||
@@ -831,7 +830,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;
|
||||
@@ -936,7 +935,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.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -1172,7 +1171,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;
|
||||
@@ -1444,6 +1442,7 @@ AddSimpleClassChainToCallContext(
|
||||
if (flags & CONSTRUCTOR) {
|
||||
AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
|
||||
filterDecl, flags);
|
||||
|
||||
} else if (flags & DESTRUCTOR) {
|
||||
AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
|
||||
filterDecl, flags);
|
||||
@@ -1518,7 +1517,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
|
||||
|
||||
+87
-58
@@ -326,8 +326,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;
|
||||
@@ -339,7 +340,6 @@ TclOOObjectSetMixins(
|
||||
if (mixinPtr && mixinPtr != oPtr->selfCls) {
|
||||
TclOORemoveFromInstances(oPtr, mixinPtr);
|
||||
}
|
||||
TclOODecrRefCount(mixinPtr->thisPtr);
|
||||
}
|
||||
oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
|
||||
sizeof(Class *) * numMixins);
|
||||
@@ -352,8 +352,6 @@ TclOOObjectSetMixins(
|
||||
FOREACH(mixinPtr, oPtr->mixins) {
|
||||
if (mixinPtr != oPtr->selfCls) {
|
||||
TclOOAddToInstances(oPtr, mixinPtr);
|
||||
/* For the new copy created by memcpy */
|
||||
AddRef(mixinPtr->thisPtr);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -383,7 +381,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;
|
||||
@@ -392,7 +389,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);
|
||||
@@ -403,8 +399,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);
|
||||
@@ -920,7 +914,7 @@ TclOODefineObjCmd(
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the previous "current" namespace.
|
||||
@@ -987,7 +981,7 @@ TclOOObjDefObjCmd(
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the previous "current" namespace.
|
||||
@@ -1054,7 +1048,7 @@ TclOODefineSelfObjCmd(
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
DelRef(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the previous "current" namespace.
|
||||
@@ -1084,7 +1078,6 @@ TclOODefineClassObjCmd(
|
||||
Object *oPtr;
|
||||
Class *clsPtr;
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
int wasClass, willBeClass;
|
||||
|
||||
/*
|
||||
* Parse the context to get the object to operate on.
|
||||
@@ -1120,10 +1113,19 @@ TclOODefineClassObjCmd(
|
||||
if (clsPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (oPtr == clsPtr->thisPtr) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"may not change classes into an instance of themselves", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
|
||||
|
||||
/*
|
||||
* 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;
|
||||
}
|
||||
|
||||
@@ -1131,38 +1133,13 @@ TclOODefineClassObjCmd(
|
||||
* Set the object's class.
|
||||
*/
|
||||
|
||||
wasClass = (oPtr->classPtr != NULL);
|
||||
willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));
|
||||
|
||||
if (oPtr->selfCls != clsPtr) {
|
||||
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
|
||||
TclOODecrRefCount(oPtr->selfCls->thisPtr);
|
||||
oPtr->selfCls = clsPtr;
|
||||
AddRef(oPtr->selfCls->thisPtr);
|
||||
TclOOAddToInstances(oPtr, oPtr->selfCls);
|
||||
|
||||
/*
|
||||
* Create or delete the class guts if necessary.
|
||||
*/
|
||||
|
||||
if (wasClass && !willBeClass) {
|
||||
/*
|
||||
* This is the most global of all epochs. Bump it! No cache can be
|
||||
* trusted!
|
||||
*/
|
||||
|
||||
TclOORemoveFromMixins(oPtr->classPtr, oPtr);
|
||||
oPtr->fPtr->epoch++;
|
||||
oPtr->flags |= DONT_DELETE;
|
||||
TclOODeleteDescendants(interp, oPtr);
|
||||
oPtr->flags &= ~DONT_DELETE;
|
||||
TclOOReleaseClassContents(interp, oPtr);
|
||||
ckfree(oPtr->classPtr);
|
||||
oPtr->classPtr = NULL;
|
||||
} else if (!wasClass && willBeClass) {
|
||||
TclOOAllocClass(interp, oPtr);
|
||||
if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) {
|
||||
oPtr->flags &= ~CLASS_GONE;
|
||||
}
|
||||
|
||||
if (oPtr->classPtr != NULL) {
|
||||
BumpGlobalEpoch(interp, oPtr->classPtr);
|
||||
} else {
|
||||
@@ -1571,6 +1548,69 @@ TclOODefineMethodObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefineMixinObjCmd --
|
||||
* Implementation of the "mixin" subcommand of the "oo::define" and
|
||||
* "oo::objdefine" commands.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOODefineMixinObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
const int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
int isInstanceMixin = (clientData != NULL);
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Class **mixins;
|
||||
int i;
|
||||
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (!isInstanceMixin && !oPtr->classPtr) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"attempt to misuse API", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
|
||||
|
||||
for (i=1 ; i<objc ; i++) {
|
||||
Class *clsPtr = GetClassInOuterContext(interp, objv[i],
|
||||
"may only mix in classes");
|
||||
|
||||
if (clsPtr == NULL) {
|
||||
goto freeAndError;
|
||||
}
|
||||
if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"may not mix a class into itself", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
|
||||
goto freeAndError;
|
||||
}
|
||||
mixins[i-1] = clsPtr;
|
||||
}
|
||||
|
||||
if (isInstanceMixin) {
|
||||
TclOOObjectSetMixins(oPtr, objc-1, mixins);
|
||||
} else {
|
||||
TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
|
||||
}
|
||||
|
||||
TclStackFree(interp, mixins);
|
||||
return TCL_OK;
|
||||
|
||||
freeAndError:
|
||||
TclStackFree(interp, mixins);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1982,7 +2022,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])) {
|
||||
@@ -2100,19 +2139,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++) {
|
||||
@@ -2129,15 +2165,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);
|
||||
ckfree((char *) superclasses);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
/* Corresponding TclOODecrRefCount() is near the end of this
|
||||
* function */
|
||||
AddRef(superclasses[i]->thisPtr);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2151,7 +2181,6 @@ ClassSuperSet(
|
||||
if (oPtr->classPtr->superclasses.num != 0) {
|
||||
FOREACH(superPtr, oPtr->classPtr->superclasses) {
|
||||
TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
|
||||
TclOODecrRefCount(superPtr->thisPtr);
|
||||
}
|
||||
ckfree((char *) oPtr->classPtr->superclasses.list);
|
||||
}
|
||||
|
||||
+6
-8
@@ -114,14 +114,12 @@ TclOOInitInfo(
|
||||
*/
|
||||
|
||||
infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
|
||||
if (infoCmd) {
|
||||
Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
|
||||
Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
|
||||
Tcl_NewStringObj("::oo::InfoObject", -1));
|
||||
Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
|
||||
Tcl_NewStringObj("::oo::InfoClass", -1));
|
||||
Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
|
||||
}
|
||||
Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
|
||||
Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
|
||||
Tcl_NewStringObj("::oo::InfoObject", -1));
|
||||
Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
|
||||
Tcl_NewStringObj("::oo::InfoClass", -1));
|
||||
Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+36
-38
@@ -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. */
|
||||
@@ -214,7 +213,6 @@ typedef struct Object {
|
||||
* other spots). */
|
||||
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
|
||||
* unknown method handler at that point. */
|
||||
#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. */
|
||||
|
||||
/*
|
||||
* And the definition of a class. Note that every class also has an associated
|
||||
@@ -224,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
|
||||
@@ -321,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.
|
||||
@@ -332,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. */
|
||||
};
|
||||
@@ -485,24 +487,15 @@ MODULE_SCOPE int TclOO_Object_VarName(ClientData clientData,
|
||||
MODULE_SCOPE void TclOOAddToInstances(Object *oPtr, Class *clsPtr);
|
||||
MODULE_SCOPE void TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
|
||||
MODULE_SCOPE void TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
|
||||
MODULE_SCOPE Class * TclOOAllocClass(Tcl_Interp *interp,
|
||||
Object *useThisObj);
|
||||
MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp,
|
||||
Tcl_Class cls, const char *nameStr,
|
||||
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);
|
||||
MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
|
||||
MODULE_SCOPE void TclOODeleteDescendants(Tcl_Interp *interp,
|
||||
Object *oPtr);
|
||||
MODULE_SCOPE void TclOODelMethodRef(Method *method);
|
||||
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
|
||||
Tcl_Obj *methodNameObj, int flags,
|
||||
@@ -528,13 +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 void TclOOReleaseClassContents(Tcl_Interp *interp,
|
||||
Object *oPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
|
||||
MODULE_SCOPE int TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
|
||||
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);
|
||||
@@ -548,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
|
||||
@@ -598,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((char *) (ptr)); \
|
||||
} \
|
||||
} while(0)
|
||||
|
||||
#endif /* TCL_OO_INTERNAL_H */
|
||||
|
||||
/*
|
||||
|
||||
@@ -970,8 +970,10 @@ ProcedureMethodVarResolver(
|
||||
* Must not retain reference to resolved information. [Bug 3105999]
|
||||
*/
|
||||
|
||||
rPtr->deleteProc(rPtr);
|
||||
return (*varPtr ? TCL_OK : TCL_CONTINUE);
|
||||
if (rPtr != NULL) {
|
||||
rPtr->deleteProc(rPtr);
|
||||
}
|
||||
return (*varPtr? TCL_OK : TCL_CONTINUE);
|
||||
}
|
||||
|
||||
static Tcl_Var
|
||||
|
||||
+14
-17
@@ -2467,26 +2467,23 @@ Tcl_SetIntObj(
|
||||
*
|
||||
* Tcl_GetIntFromObj --
|
||||
*
|
||||
* Retrieve the integer value of 'objPtr'.
|
||||
* Attempt to return an int from the Tcl object "objPtr". If the object
|
||||
* is not already an int, an attempt will be made to convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Integer and long integer objects share the same "integer" type
|
||||
* implementation. We store all integers as longs and Tcl_GetIntFromObj
|
||||
* checks whether the current value of the long can be represented by an
|
||||
* int.
|
||||
*
|
||||
* TCL_OK
|
||||
* Results:
|
||||
* The return value is a standard Tcl object result. If an error occurs
|
||||
* during conversion or if the long integer held by the object can not be
|
||||
* represented by an int, an error message is left in the interpreter's
|
||||
* result unless "interp" is NULL.
|
||||
*
|
||||
* Success.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* An error occurred during conversion or the integral value can not
|
||||
* be represented as an integer (it might be too large). An error
|
||||
* message is left in the interpreter's result if 'interp' is not
|
||||
* NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* 'objPtr' is converted to an integer if necessary if it is not one
|
||||
* already. The conversion frees any previously-existing internal
|
||||
* representation.
|
||||
* Side effects:
|
||||
* If the object is not already an int, the conversion will free any old
|
||||
* internal representation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
+5
-11
@@ -613,7 +613,7 @@ Tcl_ParseCommand(
|
||||
|
||||
int
|
||||
TclIsSpaceProc(
|
||||
int byte)
|
||||
char byte)
|
||||
{
|
||||
return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
|
||||
}
|
||||
@@ -642,7 +642,7 @@ TclIsSpaceProc(
|
||||
|
||||
int
|
||||
TclIsBareword(
|
||||
int byte)
|
||||
char byte)
|
||||
{
|
||||
if (byte < '0' || byte > 'z') {
|
||||
return 0;
|
||||
@@ -844,7 +844,7 @@ TclParseBackslash(
|
||||
Tcl_UniChar unichar = 0;
|
||||
int result;
|
||||
int count;
|
||||
char buf[TCL_UTF_MAX] = "";
|
||||
char buf[TCL_UTF_MAX];
|
||||
|
||||
if (numBytes == 0) {
|
||||
if (readPtr != NULL) {
|
||||
@@ -991,13 +991,7 @@ TclParseBackslash(
|
||||
if (readPtr != NULL) {
|
||||
*readPtr = count;
|
||||
}
|
||||
count = Tcl_UniCharToUtf(result, dst);
|
||||
#if TCL_UTF_MAX > 3
|
||||
if ((result >= 0xD800) && (count < 3)) {
|
||||
count += Tcl_UniCharToUtf(-1, dst + count);
|
||||
}
|
||||
#endif
|
||||
return count;
|
||||
return Tcl_UniCharToUtf(result, dst);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2217,7 +2211,7 @@ TclSubstTokens(
|
||||
Tcl_Obj *appendObj = NULL;
|
||||
const char *append = NULL;
|
||||
int appendByteLength = 0;
|
||||
char utfCharBytes[TCL_UTF_MAX] = "";
|
||||
char utfCharBytes[TCL_UTF_MAX];
|
||||
|
||||
switch (tokenPtr->type) {
|
||||
case TCL_TOKEN_TEXT:
|
||||
|
||||
+1
-1
@@ -12,6 +12,6 @@
|
||||
#define TYPE_CLOSE_BRACK 0x20
|
||||
#define TYPE_BRACE 0x40
|
||||
|
||||
#define CHAR_TYPE(c) (tclCharTypeTable+128)[(unsigned char)(c)]
|
||||
#define CHAR_TYPE(c) (tclCharTypeTable+128)[(int)(c)]
|
||||
|
||||
MODULE_SCOPE const char tclCharTypeTable[];
|
||||
|
||||
+39
-44
@@ -829,7 +829,7 @@ Tcl_FSJoinPath(
|
||||
* reference count. */
|
||||
int elements) /* Number of elements to use (-1 = all) */
|
||||
{
|
||||
Tcl_Obj *res;
|
||||
Tcl_Obj *copy, *res;
|
||||
int objc;
|
||||
Tcl_Obj **objv;
|
||||
|
||||
@@ -838,17 +838,17 @@ Tcl_FSJoinPath(
|
||||
}
|
||||
|
||||
elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
|
||||
copy = TclListObjCopy(NULL, listObj);
|
||||
Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
|
||||
res = TclJoinPath(elements, objv, 0);
|
||||
res = TclJoinPath(elements, objv);
|
||||
Tcl_DecrRefCount(copy);
|
||||
return res;
|
||||
}
|
||||
|
||||
Tcl_Obj *
|
||||
TclJoinPath(
|
||||
int elements, /* Number of elements to use (-1 = all) */
|
||||
Tcl_Obj * const objv[], /* Path elements to join */
|
||||
int forceRelative) /* If non-zero, assume all more paths are
|
||||
* relative (e. g. simple normalization) */
|
||||
int elements,
|
||||
Tcl_Obj * const objv[])
|
||||
{
|
||||
Tcl_Obj *res = NULL;
|
||||
int i;
|
||||
@@ -879,13 +879,10 @@ TclJoinPath(
|
||||
|
||||
if ((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(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
|
||||
Tcl_Obj *tailObj = objv[1];
|
||||
Tcl_PathType type = TclGetPathType(tailObj, NULL, NULL, NULL);
|
||||
|
||||
/* if forceRelative - second path is relative */
|
||||
type = forceRelative ? TCL_PATH_RELATIVE :
|
||||
TclGetPathType(tailObj, NULL, NULL, NULL);
|
||||
if (type == TCL_PATH_RELATIVE) {
|
||||
const char *str;
|
||||
int len;
|
||||
@@ -963,9 +960,7 @@ TclJoinPath(
|
||||
|
||||
strElt = Tcl_GetStringFromObj(elt, &strEltLen);
|
||||
driveNameLength = 0;
|
||||
/* if forceRelative - all paths excepting first one are relative */
|
||||
type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
|
||||
TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
|
||||
type = TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
|
||||
if (type != TCL_PATH_RELATIVE) {
|
||||
/*
|
||||
* Zero out the current result.
|
||||
@@ -1364,7 +1359,6 @@ TclNewFSPathObj(
|
||||
count = 0;
|
||||
state = 1;
|
||||
}
|
||||
break;
|
||||
case 1: /* Scanning for next dirsep */
|
||||
switch (*p) {
|
||||
case '/':
|
||||
@@ -1817,6 +1811,7 @@ Tcl_FSGetNormalizedPath(
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringFromObj(dir, &cwdLen);
|
||||
cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
|
||||
|
||||
/* Normalize the combined string. */
|
||||
|
||||
@@ -1838,12 +1833,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. */
|
||||
@@ -2365,29 +2360,36 @@ SetFsPathFromAny(
|
||||
* Handle tilde substitutions, if needed.
|
||||
*/
|
||||
|
||||
if (len && name[0] == '~') {
|
||||
if (name[0] == '~') {
|
||||
Tcl_DString temp;
|
||||
int split;
|
||||
char separator = '/';
|
||||
|
||||
/*
|
||||
* We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
|
||||
* split becomes value 1 for '~/...' as well as for '~'.
|
||||
*/
|
||||
split = FindSplitPos(name, separator);
|
||||
if (split != len) {
|
||||
/*
|
||||
* We have multiple pieces '~user/foo/bar...'
|
||||
*/
|
||||
|
||||
name[split] = '\0';
|
||||
}
|
||||
|
||||
/*
|
||||
* Do some tilde substitution.
|
||||
*/
|
||||
|
||||
if (split == 1) {
|
||||
if (name[1] == '\0') {
|
||||
/*
|
||||
* We have just '~' (or '~/...')
|
||||
* We have just '~'
|
||||
*/
|
||||
|
||||
const char *dir;
|
||||
Tcl_DString dirString;
|
||||
|
||||
if (split != len) {
|
||||
name[split] = separator;
|
||||
}
|
||||
|
||||
dir = TclGetEnv("HOME", &dirString);
|
||||
if (dir == NULL) {
|
||||
if (interp) {
|
||||
@@ -2407,26 +2409,23 @@ SetFsPathFromAny(
|
||||
* We have a user name '~user'
|
||||
*/
|
||||
|
||||
const char *expandedUser;
|
||||
Tcl_DString userName;
|
||||
|
||||
Tcl_DStringInit(&userName);
|
||||
Tcl_DStringAppend(&userName, name+1, split-1);
|
||||
expandedUser = Tcl_DStringValue(&userName);
|
||||
|
||||
Tcl_DStringInit(&temp);
|
||||
if (TclpGetUserHome(expandedUser, &temp) == NULL) {
|
||||
if (TclpGetUserHome(name+1, &temp) == NULL) {
|
||||
if (interp != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"user \"%s\" doesn't exist", expandedUser));
|
||||
"user \"%s\" doesn't exist", name+1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
|
||||
NULL);
|
||||
}
|
||||
Tcl_DStringFree(&userName);
|
||||
Tcl_DStringFree(&temp);
|
||||
if (split != len) {
|
||||
name[split] = separator;
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_DStringFree(&userName);
|
||||
if (split != len) {
|
||||
name[split] = separator;
|
||||
}
|
||||
}
|
||||
|
||||
transPtr = TclDStringToObj(&temp);
|
||||
@@ -2463,17 +2462,13 @@ SetFsPathFromAny(
|
||||
|
||||
pair[0] = transPtr;
|
||||
pair[1] = Tcl_NewStringObj(name+split+1, -1);
|
||||
transPtr = TclJoinPath(2, pair, 1);
|
||||
if (transPtr != pair[0]) {
|
||||
Tcl_DecrRefCount(pair[0]);
|
||||
}
|
||||
if (transPtr != pair[1]) {
|
||||
Tcl_DecrRefCount(pair[1]);
|
||||
}
|
||||
transPtr = TclJoinPath(2, pair);
|
||||
Tcl_DecrRefCount(pair[0]);
|
||||
Tcl_DecrRefCount(pair[1]);
|
||||
}
|
||||
}
|
||||
} else {
|
||||
transPtr = TclJoinPath(1, &pathPtr, 1);
|
||||
transPtr = TclJoinPath(1, &pathPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+295
-442
@@ -49,18 +49,6 @@ typedef struct Package {
|
||||
const void *clientData; /* Client data. */
|
||||
} Package;
|
||||
|
||||
typedef struct Require {
|
||||
void * clientDataPtr;
|
||||
const char *name;
|
||||
Package *pkgPtr;
|
||||
char *versionToProvide;
|
||||
} Require;
|
||||
|
||||
typedef struct RequireProcArgs {
|
||||
const char *name;
|
||||
void *clientDataPtr;
|
||||
} RequireProcArgs;
|
||||
|
||||
/*
|
||||
* Prototypes for functions defined in this file:
|
||||
*/
|
||||
@@ -81,15 +69,9 @@ static void AddRequirementsToResult(Tcl_Interp *interp, int reqc,
|
||||
static void AddRequirementsToDString(Tcl_DString *dstring,
|
||||
int reqc, Tcl_Obj *const reqv[]);
|
||||
static Package * FindPackage(Tcl_Interp *interp, const char *name);
|
||||
static int PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
|
||||
static int SelectPackage(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);
|
||||
static const char * PkgRequireCore(Tcl_Interp *interp, const char *name,
|
||||
int reqc, Tcl_Obj *const reqv[],
|
||||
void *clientDataPtr);
|
||||
|
||||
/*
|
||||
* Helper macros.
|
||||
@@ -317,10 +299,7 @@ Tcl_PkgRequireEx(
|
||||
*/
|
||||
|
||||
if (version == NULL) {
|
||||
if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
|
||||
result = Tcl_GetStringResult(interp);
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
|
||||
} else {
|
||||
if (exact && TCL_OK
|
||||
!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
|
||||
@@ -331,12 +310,10 @@ Tcl_PkgRequireEx(
|
||||
Tcl_AppendStringsToObj(ov, "-", version, NULL);
|
||||
}
|
||||
Tcl_IncrRefCount(ov);
|
||||
if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
|
||||
result = Tcl_GetStringResult(interp);
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
|
||||
TclDecrRefCount(ov);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
@@ -351,130 +328,306 @@ Tcl_PkgRequireProc(
|
||||
* available. */
|
||||
void *clientDataPtr)
|
||||
{
|
||||
RequireProcArgs args;
|
||||
args.name = name;
|
||||
args.clientDataPtr = clientDataPtr;
|
||||
return Tcl_NRCallObjProc(interp, TclNRPkgRequireProc, (void *)&args, reqc, reqv);
|
||||
}
|
||||
const char *result =
|
||||
PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
|
||||
|
||||
static int
|
||||
TclNRPkgRequireProc(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int reqc,
|
||||
Tcl_Obj *const reqv[]) {
|
||||
RequireProcArgs *args = clientData;
|
||||
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)args->name, INT2PTR(reqc), (void *)reqv, args->clientDataPtr);
|
||||
if (result == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result)
|
||||
static const char *
|
||||
PkgRequireCore(
|
||||
Tcl_Interp *interp, /* Interpreter in which package is now
|
||||
* available. */
|
||||
const char *name, /* Name of desired package. */
|
||||
int reqc, /* Requirements constraining the desired
|
||||
* version. */
|
||||
Tcl_Obj *const reqv[], /* 0 means to use the latest version
|
||||
* available. */
|
||||
void *clientDataPtr)
|
||||
{
|
||||
const char *name = data[0];
|
||||
int reqc = PTR2INT(data[1]);
|
||||
Tcl_Obj *const *reqv = data[2];
|
||||
int code = CheckAllRequirements(interp, reqc, reqv);
|
||||
Require *reqPtr;
|
||||
if (code != TCL_OK) {
|
||||
return code;
|
||||
}
|
||||
reqPtr = ckalloc(sizeof(Require));
|
||||
Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
|
||||
reqPtr->clientDataPtr = data[3];
|
||||
reqPtr->name = name;
|
||||
reqPtr->pkgPtr = FindPackage(interp, name);
|
||||
if (reqPtr->pkgPtr->version == NULL) {
|
||||
Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreStep1);
|
||||
} else {
|
||||
Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Package *pkgPtr;
|
||||
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
|
||||
char *availVersion, *bestVersion;
|
||||
/* Internal rep. of versions */
|
||||
int availStable, code, satisfies, pass;
|
||||
char *script, *pkgVersionI;
|
||||
Tcl_DString command;
|
||||
char *script;
|
||||
Require *reqPtr = data[0];
|
||||
int reqc = PTR2INT(data[1]);
|
||||
Tcl_Obj **const reqv = data[2];
|
||||
const char *name = reqPtr->name /* Name of desired package. */;
|
||||
if (reqPtr->pkgPtr->version == NULL) {
|
||||
|
||||
if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* It can take up to three passes to find the package: one pass to run the
|
||||
* "package unknown" script, one to run the "package ifneeded" script for
|
||||
* a specific version, and a final pass to lookup the package loaded by
|
||||
* the "package ifneeded" script.
|
||||
*/
|
||||
|
||||
for (pass=1 ;; pass++) {
|
||||
pkgPtr = FindPackage(interp, name);
|
||||
if (pkgPtr->version != NULL) {
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check whether we're already attempting to load some version of this
|
||||
* package (circular dependency detection).
|
||||
*/
|
||||
|
||||
if (pkgPtr->clientData != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"circular package dependency:"
|
||||
" attempt to provide %s %s requires %s",
|
||||
name, (char *) pkgPtr->clientData, name));
|
||||
AddRequirementsToResult(interp, reqc, reqv);
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* The package isn't yet present. Search the list of available
|
||||
* versions and invoke the script for the best available version. We
|
||||
* are actually locating the best, and the best stable version. One of
|
||||
* them is then chosen based on the selection mode.
|
||||
*/
|
||||
|
||||
bestPtr = NULL;
|
||||
bestStablePtr = NULL;
|
||||
bestVersion = NULL;
|
||||
|
||||
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
|
||||
availPtr = availPtr->nextPtr) {
|
||||
if (CheckVersionAndConvert(interp, availPtr->version,
|
||||
&availVersion, &availStable) != TCL_OK) {
|
||||
/*
|
||||
* The provided version number has invalid syntax. This
|
||||
* should not happen. This should have been caught by the
|
||||
* 'package ifneeded' registering the package.
|
||||
*/
|
||||
|
||||
continue;
|
||||
}
|
||||
|
||||
if (bestPtr != NULL) {
|
||||
int res = CompareVersions(availVersion, bestVersion, NULL);
|
||||
|
||||
/*
|
||||
* Note: Use internal reps!
|
||||
*/
|
||||
|
||||
if (res <= 0) {
|
||||
/*
|
||||
* The version of the package sought is not as good as the
|
||||
* currently selected version. Ignore it.
|
||||
*/
|
||||
|
||||
ckfree(availVersion);
|
||||
availVersion = NULL;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* The package is not in the database. If there is a "package unknown"
|
||||
* command, invoke it.
|
||||
* We have found a version which is better than our max.
|
||||
*/
|
||||
|
||||
script = ((Interp *) interp)->packageUnknown;
|
||||
if (script == NULL) {
|
||||
Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
|
||||
} else {
|
||||
Tcl_DStringInit(&command);
|
||||
Tcl_DStringAppend(&command, script, -1);
|
||||
Tcl_DStringAppendElement(&command, name);
|
||||
AddRequirementsToDString(&command, reqc, reqv);
|
||||
if (reqc > 0) {
|
||||
/* Check satisfaction of requirements. */
|
||||
|
||||
Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
|
||||
Tcl_NREvalObj(interp,
|
||||
Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)),
|
||||
TCL_EVAL_GLOBAL
|
||||
);
|
||||
Tcl_DStringFree(&command);
|
||||
satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
|
||||
if (!satisfies) {
|
||||
ckfree(availVersion);
|
||||
availVersion = NULL;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
return TCL_OK;
|
||||
} else {
|
||||
Tcl_NRAddCallback(interp, PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
Require *reqPtr = data[0];
|
||||
int reqc = PTR2INT(data[1]);
|
||||
Tcl_Obj **const reqv = data[2];
|
||||
const char *name = reqPtr->name /* Name of desired package. */;
|
||||
if ((result != TCL_OK) && (result != TCL_ERROR)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad return code: %d", result));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
if (result == TCL_ERROR) {
|
||||
Tcl_AddErrorInfo(interp,
|
||||
"\n (\"package unknown\" script)");
|
||||
return result;
|
||||
}
|
||||
Tcl_ResetResult(interp);
|
||||
/* pkgPtr may now be invalid, so refresh it. */
|
||||
reqPtr->pkgPtr = FindPackage(interp, name);
|
||||
Tcl_NRAddCallback(interp, SelectPackage, reqPtr, INT2PTR(reqc), (void *)reqv, PkgRequireCoreFinal);
|
||||
return TCL_OK;
|
||||
}
|
||||
bestPtr = availPtr;
|
||||
|
||||
static int
|
||||
PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
Require *reqPtr = data[0];
|
||||
int reqc = PTR2INT(data[1]), satisfies;
|
||||
Tcl_Obj **const reqv = data[2];
|
||||
char *pkgVersionI;
|
||||
void *clientDataPtr = reqPtr->clientDataPtr;
|
||||
const char *name = reqPtr->name /* Name of desired package. */;
|
||||
if (reqPtr->pkgPtr->version == NULL) {
|
||||
if (bestVersion != NULL) {
|
||||
ckfree(bestVersion);
|
||||
}
|
||||
bestVersion = availVersion;
|
||||
|
||||
/*
|
||||
* If this new best version is stable then it also has to be
|
||||
* better than the max stable version found so far.
|
||||
*/
|
||||
|
||||
if (availStable) {
|
||||
bestStablePtr = availPtr;
|
||||
}
|
||||
}
|
||||
|
||||
if (bestVersion != NULL) {
|
||||
ckfree(bestVersion);
|
||||
}
|
||||
|
||||
/*
|
||||
* Now choose a version among the two best. For 'latest' we simply
|
||||
* take (actually keep) the best. For 'stable' we take the best
|
||||
* stable, if there is any, or the best if there is nothing stable.
|
||||
*/
|
||||
|
||||
if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
|
||||
&& (bestStablePtr != NULL)) {
|
||||
bestPtr = bestStablePtr;
|
||||
}
|
||||
|
||||
if (bestPtr != NULL) {
|
||||
/*
|
||||
* We found an ifneeded script for the package. Be careful while
|
||||
* executing it: this could cause reentrancy, so (a) protect the
|
||||
* script itself from deletion and (b) don't assume that bestPtr
|
||||
* will still exist when the script completes.
|
||||
*/
|
||||
|
||||
char *versionToProvide = bestPtr->version;
|
||||
script = bestPtr->script;
|
||||
|
||||
pkgPtr->clientData = versionToProvide;
|
||||
Tcl_Preserve(script);
|
||||
Tcl_Preserve(versionToProvide);
|
||||
code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
|
||||
Tcl_Release(script);
|
||||
|
||||
pkgPtr = FindPackage(interp, name);
|
||||
if (code == TCL_OK) {
|
||||
Tcl_ResetResult(interp);
|
||||
if (pkgPtr->version == NULL) {
|
||||
code = TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" no version of package %s provided",
|
||||
name, versionToProvide, name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
|
||||
NULL);
|
||||
} else {
|
||||
char *pvi, *vi;
|
||||
|
||||
if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
|
||||
NULL) != TCL_OK) {
|
||||
code = TCL_ERROR;
|
||||
} else if (CheckVersionAndConvert(interp,
|
||||
versionToProvide, &vi, NULL) != TCL_OK) {
|
||||
ckfree(pvi);
|
||||
code = TCL_ERROR;
|
||||
} else {
|
||||
int res = CompareVersions(pvi, vi, NULL);
|
||||
|
||||
ckfree(pvi);
|
||||
ckfree(vi);
|
||||
if (res != 0) {
|
||||
code = TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" package %s %s provided instead",
|
||||
name, versionToProvide,
|
||||
name, pkgPtr->version));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
|
||||
"WRONGPROVIDE", NULL);
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (code != TCL_ERROR) {
|
||||
Tcl_Obj *codePtr = Tcl_NewIntObj(code);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" bad return code: %s",
|
||||
name, versionToProvide, TclGetString(codePtr)));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
|
||||
TclDecrRefCount(codePtr);
|
||||
code = TCL_ERROR;
|
||||
}
|
||||
|
||||
if (code == TCL_ERROR) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (\"package ifneeded %s %s\" script)",
|
||||
name, versionToProvide));
|
||||
}
|
||||
Tcl_Release(versionToProvide);
|
||||
|
||||
if (code != TCL_OK) {
|
||||
/*
|
||||
* Take a non-TCL_OK code from the script as an indication the
|
||||
* package wasn't loaded properly, so the package system
|
||||
* should not remember an improper load.
|
||||
*
|
||||
* This is consistent with our returning NULL. If we're not
|
||||
* willing to tell our caller we got a particular version, we
|
||||
* shouldn't store that version for telling future callers
|
||||
* either.
|
||||
*/
|
||||
|
||||
if (pkgPtr->version != NULL) {
|
||||
ckfree(pkgPtr->version);
|
||||
pkgPtr->version = NULL;
|
||||
}
|
||||
pkgPtr->clientData = NULL;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
* The package is not in the database. If there is a "package unknown"
|
||||
* command, invoke it (but only on the first pass; after that, we
|
||||
* should not get here in the first place).
|
||||
*/
|
||||
|
||||
if (pass > 1) {
|
||||
break;
|
||||
}
|
||||
|
||||
script = ((Interp *) interp)->packageUnknown;
|
||||
if (script != NULL) {
|
||||
Tcl_DStringInit(&command);
|
||||
Tcl_DStringAppend(&command, script, -1);
|
||||
Tcl_DStringAppendElement(&command, name);
|
||||
AddRequirementsToDString(&command, reqc, reqv);
|
||||
|
||||
code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
|
||||
Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
|
||||
Tcl_DStringFree(&command);
|
||||
|
||||
if ((code != TCL_OK) && (code != TCL_ERROR)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad return code: %d", code));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
|
||||
code = TCL_ERROR;
|
||||
}
|
||||
if (code == TCL_ERROR) {
|
||||
Tcl_AddErrorInfo(interp,
|
||||
"\n (\"package unknown\" script)");
|
||||
return NULL;
|
||||
}
|
||||
Tcl_ResetResult(interp);
|
||||
}
|
||||
}
|
||||
|
||||
if (pkgPtr->version == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"can't find package %s", name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
|
||||
AddRequirementsToResult(interp, reqc, reqv);
|
||||
return TCL_ERROR;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Ensure that the provided version meets the current requirements.
|
||||
* At this point we know that the package is present. Make sure that the
|
||||
* provided version meets the current requirements.
|
||||
*/
|
||||
|
||||
if (reqc != 0) {
|
||||
CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pkgVersionI, NULL);
|
||||
CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
|
||||
satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);
|
||||
|
||||
ckfree(pkgVersionI);
|
||||
@@ -482,283 +635,20 @@ PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
if (!satisfies) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"version conflict for package \"%s\": have %s, need",
|
||||
name, reqPtr->pkgPtr->version));
|
||||
name, pkgPtr->version));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
|
||||
NULL);
|
||||
AddRequirementsToResult(interp, reqc, reqv);
|
||||
return TCL_ERROR;
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
if (clientDataPtr) {
|
||||
const void **ptr = (const void **) clientDataPtr;
|
||||
|
||||
*ptr = reqPtr->pkgPtr->clientData;
|
||||
*ptr = pkgPtr->clientData;
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(reqPtr->pkgPtr->version, -1));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
ckfree(data[0]);
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
|
||||
char *availVersion, *bestVersion, *bestStableVersion;
|
||||
/* Internal rep. of versions */
|
||||
int availStable, satisfies;
|
||||
Require *reqPtr = data[0];
|
||||
int reqc = PTR2INT(data[1]);
|
||||
Tcl_Obj **const reqv = data[2];
|
||||
const char *name = reqPtr->name;
|
||||
Package *pkgPtr = reqPtr->pkgPtr;
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Check whether we're already attempting to load some version of this
|
||||
* package (circular dependency detection).
|
||||
*/
|
||||
|
||||
if (pkgPtr->clientData != NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"circular package dependency:"
|
||||
" attempt to provide %s %s requires %s",
|
||||
name, (char *) pkgPtr->clientData, name));
|
||||
AddRequirementsToResult(interp, reqc, reqv);
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* The package isn't yet present. Search the list of available
|
||||
* versions and invoke the script for the best available version. We
|
||||
* are actually locating the best, and the best stable version. One of
|
||||
* them is then chosen based on the selection mode.
|
||||
*/
|
||||
|
||||
bestPtr = NULL;
|
||||
bestStablePtr = NULL;
|
||||
bestVersion = NULL;
|
||||
bestStableVersion = NULL;
|
||||
|
||||
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
|
||||
availPtr = availPtr->nextPtr) {
|
||||
if (CheckVersionAndConvert(interp, availPtr->version,
|
||||
&availVersion, &availStable) != TCL_OK) {
|
||||
/*
|
||||
* The provided version number has invalid syntax. This
|
||||
* should not happen. This should have been caught by the
|
||||
* 'package ifneeded' registering the package.
|
||||
*/
|
||||
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Check satisfaction of requirements before considering the current version further. */
|
||||
if (reqc > 0) {
|
||||
satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
|
||||
if (!satisfies) {
|
||||
ckfree(availVersion);
|
||||
availVersion = NULL;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
if (bestPtr != NULL) {
|
||||
int res = CompareVersions(availVersion, bestVersion, NULL);
|
||||
|
||||
/*
|
||||
* Note: Used internal reps in the comparison!
|
||||
*/
|
||||
|
||||
if (res > 0) {
|
||||
/*
|
||||
* The version of the package sought is better than the
|
||||
* currently selected version.
|
||||
*/
|
||||
ckfree(bestVersion);
|
||||
bestVersion = NULL;
|
||||
goto newbest;
|
||||
}
|
||||
} else {
|
||||
newbest:
|
||||
/* We have found a version which is better than our max. */
|
||||
|
||||
bestPtr = availPtr;
|
||||
CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
|
||||
}
|
||||
|
||||
if (!availStable) {
|
||||
ckfree(availVersion);
|
||||
availVersion = NULL;
|
||||
continue;
|
||||
}
|
||||
|
||||
if (bestStablePtr != NULL) {
|
||||
int res = CompareVersions(availVersion, bestStableVersion, NULL);
|
||||
|
||||
/*
|
||||
* Note: Used internal reps in the comparison!
|
||||
*/
|
||||
|
||||
if (res > 0) {
|
||||
/*
|
||||
* This stable version of the package sought is better
|
||||
* than the currently selected stable version.
|
||||
*/
|
||||
ckfree(bestStableVersion);
|
||||
bestStableVersion = NULL;
|
||||
goto newstable;
|
||||
}
|
||||
} else {
|
||||
newstable:
|
||||
/* We have found a stable version which is better than our max stable. */
|
||||
bestStablePtr = availPtr;
|
||||
CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
|
||||
}
|
||||
|
||||
ckfree(availVersion);
|
||||
availVersion = NULL;
|
||||
} /* end for */
|
||||
|
||||
/*
|
||||
* Clean up memorized internal reps, if any.
|
||||
*/
|
||||
|
||||
if (bestVersion != NULL) {
|
||||
ckfree(bestVersion);
|
||||
bestVersion = NULL;
|
||||
}
|
||||
|
||||
if (bestStableVersion != NULL) {
|
||||
ckfree(bestStableVersion);
|
||||
bestStableVersion = NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
* Now choose a version among the two best. For 'latest' we simply
|
||||
* take (actually keep) the best. For 'stable' we take the best
|
||||
* stable, if there is any, or the best if there is nothing stable.
|
||||
*/
|
||||
|
||||
if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
|
||||
&& (bestStablePtr != NULL)) {
|
||||
bestPtr = bestStablePtr;
|
||||
}
|
||||
|
||||
if (bestPtr == NULL) {
|
||||
Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
|
||||
} else {
|
||||
/*
|
||||
* We found an ifneeded script for the package. Be careful while
|
||||
* executing it: this could cause reentrancy, so (a) protect the
|
||||
* script itself from deletion and (b) don't assume that bestPtr
|
||||
* will still exist when the script completes.
|
||||
*/
|
||||
|
||||
char *versionToProvide = bestPtr->version;
|
||||
|
||||
pkgPtr->clientData = versionToProvide;
|
||||
Tcl_Preserve(versionToProvide);
|
||||
reqPtr->versionToProvide = versionToProvide;
|
||||
Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]);
|
||||
Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
Require *reqPtr = data[0];
|
||||
int reqc = PTR2INT(data[1]);
|
||||
Tcl_Obj **const reqv = data[2];
|
||||
const char *name = reqPtr->name;
|
||||
char *versionToProvide = reqPtr->versionToProvide;
|
||||
|
||||
reqPtr->pkgPtr = FindPackage(interp, name);
|
||||
if (result == TCL_OK) {
|
||||
Tcl_ResetResult(interp);
|
||||
if (reqPtr->pkgPtr->version == NULL) {
|
||||
result = TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" no version of package %s provided",
|
||||
name, versionToProvide, name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
|
||||
NULL);
|
||||
} else {
|
||||
char *pvi, *vi;
|
||||
|
||||
if (CheckVersionAndConvert(interp, reqPtr->pkgPtr->version, &pvi,
|
||||
NULL) != TCL_OK) {
|
||||
result = TCL_ERROR;
|
||||
} else if (CheckVersionAndConvert(interp,
|
||||
versionToProvide, &vi, NULL) != TCL_OK) {
|
||||
ckfree(pvi);
|
||||
result = TCL_ERROR;
|
||||
} else {
|
||||
int res = CompareVersions(pvi, vi, NULL);
|
||||
|
||||
ckfree(pvi);
|
||||
ckfree(vi);
|
||||
if (res != 0) {
|
||||
result = TCL_ERROR;
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" package %s %s provided instead",
|
||||
name, versionToProvide,
|
||||
name, reqPtr->pkgPtr->version));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
|
||||
"WRONGPROVIDE", NULL);
|
||||
}
|
||||
}
|
||||
}
|
||||
} else if (result != TCL_ERROR) {
|
||||
Tcl_Obj *codePtr = Tcl_NewIntObj(result);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"attempt to provide package %s %s failed:"
|
||||
" bad return code: %s",
|
||||
name, versionToProvide, TclGetString(codePtr)));
|
||||
Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
|
||||
TclDecrRefCount(codePtr);
|
||||
result = TCL_ERROR;
|
||||
}
|
||||
|
||||
if (result == TCL_ERROR) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (\"package ifneeded %s %s\" script)",
|
||||
name, versionToProvide));
|
||||
}
|
||||
Tcl_Release(versionToProvide);
|
||||
|
||||
if (result != TCL_OK) {
|
||||
/*
|
||||
* Take a non-TCL_OK code from the script as an indication the
|
||||
* package wasn't loaded properly, so the package system
|
||||
* should not remember an improper load.
|
||||
*
|
||||
* This is consistent with our returning NULL. If we're not
|
||||
* willing to tell our caller we got a particular version, we
|
||||
* shouldn't store that version for telling future callers
|
||||
* either.
|
||||
*/
|
||||
|
||||
if (reqPtr->pkgPtr->version != NULL) {
|
||||
ckfree(reqPtr->pkgPtr->version);
|
||||
reqPtr->pkgPtr->version = NULL;
|
||||
}
|
||||
reqPtr->pkgPtr->clientData = NULL;
|
||||
return result;
|
||||
}
|
||||
|
||||
Tcl_NRAddCallback(interp, data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
|
||||
return TCL_OK;
|
||||
return pkgPtr->version;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -864,19 +754,10 @@ Tcl_PkgPresentEx(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
int
|
||||
Tcl_PackageObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv);
|
||||
}
|
||||
|
||||
/* ARGSUSED */
|
||||
int
|
||||
TclNRPackageObjCmd(
|
||||
Tcl_PackageObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
@@ -893,7 +774,7 @@ TclNRPackageObjCmd(
|
||||
PKG_VSATISFIES
|
||||
};
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
int optionIndex, exact, i, newobjc, satisfies;
|
||||
int optionIndex, exact, i, satisfies;
|
||||
PkgAvail *availPtr, *prevPtr;
|
||||
Package *pkgPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
@@ -902,7 +783,6 @@ TclNRPackageObjCmd(
|
||||
const char *version;
|
||||
const char *argv2, *argv3, *argv4;
|
||||
char *iva = NULL, *ivb = NULL;
|
||||
Tcl_Obj *objvListPtr, **newObjvPtr;
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
|
||||
@@ -1109,6 +989,7 @@ TclNRPackageObjCmd(
|
||||
argv2 = TclGetString(objv[2]);
|
||||
if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
|
||||
Tcl_Obj *ov;
|
||||
int res;
|
||||
|
||||
if (objc != 5) {
|
||||
goto requireSyntax;
|
||||
@@ -1128,38 +1009,17 @@ TclNRPackageObjCmd(
|
||||
Tcl_AppendStringsToObj(ov, "-", version, NULL);
|
||||
version = NULL;
|
||||
argv3 = TclGetString(objv[3]);
|
||||
Tcl_IncrRefCount(objv[3]);
|
||||
|
||||
objvListPtr = Tcl_NewListObj(0, NULL);
|
||||
Tcl_IncrRefCount(objvListPtr);
|
||||
Tcl_ListObjAppendElement(interp, objvListPtr, ov);
|
||||
Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
|
||||
|
||||
Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL);
|
||||
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL);
|
||||
return TCL_OK;
|
||||
Tcl_IncrRefCount(ov);
|
||||
res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
|
||||
TclDecrRefCount(ov);
|
||||
return res;
|
||||
} else {
|
||||
int i, newobjc = objc-3;
|
||||
Tcl_Obj *const *newobjv = objv + 3;
|
||||
if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
objvListPtr = Tcl_NewListObj(0, NULL);
|
||||
Tcl_IncrRefCount(objvListPtr);
|
||||
Tcl_IncrRefCount(objv[2]);
|
||||
for (i = 0; i < newobjc; i++) {
|
||||
|
||||
/*
|
||||
* Tcl_Obj structures may have come from another interpreter,
|
||||
* so duplicate them.
|
||||
*/
|
||||
|
||||
Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i]));
|
||||
}
|
||||
Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
|
||||
Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL);
|
||||
Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv2, INT2PTR(newobjc), newObjvPtr, NULL);
|
||||
return TCL_OK;
|
||||
return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
|
||||
}
|
||||
break;
|
||||
case PKG_UNKNOWN: {
|
||||
@@ -1299,13 +1159,6 @@ TclNRPackageObjCmd(
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result) {
|
||||
TclDecrRefCount((Tcl_Obj *)data[0]);
|
||||
TclDecrRefCount((Tcl_Obj *)data[1]);
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
|
||||
+116
-78
@@ -124,10 +124,11 @@ Tcl_ProcObjCmd(
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
Proc *procPtr;
|
||||
const char *procName;
|
||||
const char *simpleName, *procArgs, *procBody;
|
||||
const char *fullName;
|
||||
const char *procName, *procArgs, *procBody;
|
||||
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
|
||||
Tcl_Command cmd;
|
||||
Tcl_DString ds;
|
||||
|
||||
if (objc != 4) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "name args body");
|
||||
@@ -140,21 +141,29 @@ Tcl_ProcObjCmd(
|
||||
* namespace.
|
||||
*/
|
||||
|
||||
procName = TclGetString(objv[1]);
|
||||
TclGetNamespaceForQualName(interp, procName, NULL, 0,
|
||||
&nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
|
||||
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", "VALUE", "COMMAND", 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", 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", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -163,16 +172,31 @@ Tcl_ProcObjCmd(
|
||||
* Create the data structure to represent the procedure.
|
||||
*/
|
||||
|
||||
if (TclCreateProc(interp, nsPtr, simpleName, objv[2], objv[3],
|
||||
if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
|
||||
&procPtr) != TCL_OK) {
|
||||
Tcl_AddErrorInfo(interp, "\n (creating proc \"");
|
||||
Tcl_AddErrorInfo(interp, simpleName);
|
||||
Tcl_AddErrorInfo(interp, procName);
|
||||
Tcl_AddErrorInfo(interp, "\")");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
|
||||
TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);
|
||||
/*
|
||||
* Now create a command for the procedure. This will initially be in the
|
||||
* current namespace unless the procedure's name included namespace
|
||||
* qualifiers. To create the new command in the right namespace, we
|
||||
* generate a fully qualified name for it.
|
||||
*/
|
||||
|
||||
Tcl_DStringInit(&ds);
|
||||
if (nsPtr != iPtr->globalNsPtr) {
|
||||
Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
|
||||
TclDStringAppendLiteral(&ds, "::");
|
||||
}
|
||||
Tcl_DStringAppend(&ds, procName, -1);
|
||||
|
||||
cmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds), TclObjInterpProc,
|
||||
TclNRInterpProc, procPtr, TclProcDeleteProc);
|
||||
Tcl_DStringFree(&ds);
|
||||
|
||||
/*
|
||||
* Now initialize the new procedure's cmdPtr field. This will be used
|
||||
@@ -369,11 +393,13 @@ TclCreateProc(
|
||||
Proc **procPtrPtr) /* Returns: pointer to proc data. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
const char **argArray = NULL;
|
||||
|
||||
register Proc *procPtr;
|
||||
int i, result, numArgs;
|
||||
int i, length, result, numArgs;
|
||||
const char *args, *bytes, *p;
|
||||
register CompiledLocal *localPtr = NULL;
|
||||
Tcl_Obj **argArray;
|
||||
Tcl_Obj *defPtr;
|
||||
int precompiled = 0;
|
||||
|
||||
if (bodyPtr->typePtr == &tclProcBodyType) {
|
||||
@@ -410,8 +436,6 @@ TclCreateProc(
|
||||
*/
|
||||
|
||||
if (Tcl_IsShared(bodyPtr)) {
|
||||
const char *bytes;
|
||||
int length;
|
||||
Tcl_Obj *sharedBodyPtr = bodyPtr;
|
||||
|
||||
bytes = TclGetStringFromObj(bodyPtr, &length);
|
||||
@@ -449,9 +473,12 @@ TclCreateProc(
|
||||
* argument specifier. If the body is precompiled, processing is limited
|
||||
* to checking that the parsed argument is consistent with the one stored
|
||||
* in the Proc.
|
||||
*
|
||||
* THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
|
||||
*/
|
||||
|
||||
result = Tcl_ListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
|
||||
args = TclGetStringFromObj(argsPtr, &length);
|
||||
result = Tcl_SplitList(interp, args, &numArgs, &argArray);
|
||||
if (result != TCL_OK) {
|
||||
goto procError;
|
||||
}
|
||||
@@ -473,30 +500,29 @@ TclCreateProc(
|
||||
}
|
||||
|
||||
for (i = 0; i < numArgs; i++) {
|
||||
const char *argname, *argnamei, *argnamelast;
|
||||
int fieldCount, nameLength;
|
||||
Tcl_Obj **fieldValues;
|
||||
int fieldCount, nameLength, valueLength;
|
||||
const char **fieldValues;
|
||||
|
||||
/*
|
||||
* Now divide the specifier up into name and default.
|
||||
*/
|
||||
|
||||
result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount,
|
||||
result = Tcl_SplitList(interp, argArray[i], &fieldCount,
|
||||
&fieldValues);
|
||||
if (result != TCL_OK) {
|
||||
goto procError;
|
||||
}
|
||||
if (fieldCount > 2) {
|
||||
Tcl_Obj *errorObj = Tcl_NewStringObj(
|
||||
"too many fields in argument specifier \"", -1);
|
||||
Tcl_AppendObjToObj(errorObj, argArray[i]);
|
||||
Tcl_AppendToObj(errorObj, "\"", -1);
|
||||
Tcl_SetObjResult(interp, errorObj);
|
||||
ckfree(fieldValues);
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"too many fields in argument specifier \"%s\"",
|
||||
argArray[i]));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"FORMALARGUMENTFORMAT", NULL);
|
||||
goto procError;
|
||||
}
|
||||
if ((fieldCount == 0) || (fieldValues[0]->length == 0)) {
|
||||
if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
|
||||
ckfree(fieldValues);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"argument with no name", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
@@ -504,35 +530,44 @@ TclCreateProc(
|
||||
goto procError;
|
||||
}
|
||||
|
||||
argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength);
|
||||
nameLength = strlen(fieldValues[0]);
|
||||
if (fieldCount == 2) {
|
||||
valueLength = strlen(fieldValues[1]);
|
||||
} else {
|
||||
valueLength = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check that the formal parameter name is a scalar.
|
||||
*/
|
||||
|
||||
argnamei = argname;
|
||||
argnamelast = Tcl_UtfPrev(argname + nameLength, argname);
|
||||
while (argnamei < argnamelast) {
|
||||
if (*argnamei == '(') {
|
||||
if (*argnamelast == ')') { /* We have an array element. */
|
||||
p = fieldValues[0];
|
||||
while (*p != '\0') {
|
||||
if (*p == '(') {
|
||||
const char *q = p;
|
||||
do {
|
||||
q++;
|
||||
} while (*q != '\0');
|
||||
q--;
|
||||
if (*q == ')') { /* We have an array element. */
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"formal parameter \"%s\" is an array element",
|
||||
Tcl_GetString(fieldValues[0])));
|
||||
fieldValues[0]));
|
||||
ckfree(fieldValues);
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"FORMALARGUMENTFORMAT", NULL);
|
||||
goto procError;
|
||||
}
|
||||
} else if (*argnamei == ':' && *(argnamei+1) == ':') {
|
||||
Tcl_Obj *errorObj = Tcl_NewStringObj(
|
||||
"formal parameter \"", -1);
|
||||
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
|
||||
Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
|
||||
Tcl_SetObjResult(interp, errorObj);
|
||||
} else if ((*p == ':') && (*(p+1) == ':')) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"formal parameter \"%s\" is not a simple name",
|
||||
fieldValues[0]));
|
||||
ckfree(fieldValues);
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"FORMALARGUMENTFORMAT", NULL);
|
||||
goto procError;
|
||||
}
|
||||
argnamei = Tcl_UtfNext(argnamei);
|
||||
p++;
|
||||
}
|
||||
|
||||
if (precompiled) {
|
||||
@@ -548,7 +583,7 @@ TclCreateProc(
|
||||
*/
|
||||
|
||||
if ((localPtr->nameLength != nameLength)
|
||||
|| (memcmp(localPtr->name, argname, nameLength) != 0)
|
||||
|| (strcmp(localPtr->name, fieldValues[0]))
|
||||
|| (localPtr->frameIndex != i)
|
||||
|| !(localPtr->flags & VAR_ARGUMENT)
|
||||
|| (localPtr->defValuePtr == NULL && fieldCount == 2)
|
||||
@@ -556,6 +591,7 @@ TclCreateProc(
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"procedure \"%s\": formal parameter %d is "
|
||||
"inconsistent with precompiled body", procName, i));
|
||||
ckfree(fieldValues);
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"BYTECODELIES", NULL);
|
||||
goto procError;
|
||||
@@ -566,21 +602,17 @@ TclCreateProc(
|
||||
*/
|
||||
|
||||
if (localPtr->defValuePtr != NULL) {
|
||||
int tmpLength, valueLength;
|
||||
int tmpLength;
|
||||
const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
|
||||
&tmpLength);
|
||||
const char *value = TclGetStringFromObj(fieldValues[1],
|
||||
&valueLength);
|
||||
|
||||
if ((valueLength != tmpLength)
|
||||
|| memcmp(value, tmpPtr, tmpLength) != 0
|
||||
) {
|
||||
Tcl_Obj *errorObj = Tcl_ObjPrintf(
|
||||
"procedure \"%s\": formal parameter \"", procName);
|
||||
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
|
||||
Tcl_AppendToObj(errorObj, "\" has "
|
||||
"default value inconsistent with precompiled body", -1);
|
||||
Tcl_SetObjResult(interp, errorObj);
|
||||
if ((valueLength != tmpLength) ||
|
||||
strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"procedure \"%s\": formal parameter \"%s\" has "
|
||||
"default value inconsistent with precompiled body",
|
||||
procName, fieldValues[0]));
|
||||
ckfree(fieldValues);
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
|
||||
"BYTECODELIES", NULL);
|
||||
goto procError;
|
||||
@@ -600,7 +632,7 @@ TclCreateProc(
|
||||
* local variables for the argument.
|
||||
*/
|
||||
|
||||
localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
|
||||
localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameLength+1);
|
||||
if (procPtr->firstLocalPtr == NULL) {
|
||||
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
|
||||
} else {
|
||||
@@ -614,22 +646,26 @@ TclCreateProc(
|
||||
localPtr->resolveInfo = NULL;
|
||||
|
||||
if (fieldCount == 2) {
|
||||
localPtr->defValuePtr = fieldValues[1];
|
||||
localPtr->defValuePtr =
|
||||
Tcl_NewStringObj(fieldValues[1], valueLength);
|
||||
Tcl_IncrRefCount(localPtr->defValuePtr);
|
||||
} else {
|
||||
localPtr->defValuePtr = NULL;
|
||||
}
|
||||
memcpy(localPtr->name, argname, fieldValues[0]->length + 1);
|
||||
memcpy(localPtr->name, fieldValues[0], nameLength + 1);
|
||||
if ((i == numArgs - 1)
|
||||
&& (localPtr->nameLength == 4)
|
||||
&& (localPtr->name[0] == 'a')
|
||||
&& (memcmp(localPtr->name, "args", 4) == 0)) {
|
||||
&& (strcmp(localPtr->name, "args") == 0)) {
|
||||
localPtr->flags |= VAR_IS_ARGS;
|
||||
}
|
||||
}
|
||||
|
||||
ckfree(fieldValues);
|
||||
}
|
||||
|
||||
*procPtrPtr = procPtr;
|
||||
ckfree(argArray);
|
||||
return TCL_OK;
|
||||
|
||||
procError:
|
||||
@@ -641,14 +677,18 @@ TclCreateProc(
|
||||
localPtr = procPtr->firstLocalPtr;
|
||||
procPtr->firstLocalPtr = localPtr->nextPtr;
|
||||
|
||||
if (localPtr->defValuePtr != NULL) {
|
||||
Tcl_DecrRefCount(localPtr->defValuePtr);
|
||||
defPtr = localPtr->defValuePtr;
|
||||
if (defPtr != NULL) {
|
||||
Tcl_DecrRefCount(defPtr);
|
||||
}
|
||||
|
||||
ckfree(localPtr);
|
||||
}
|
||||
ckfree(procPtr);
|
||||
}
|
||||
if (argArray != NULL) {
|
||||
ckfree(argArray);
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
@@ -1031,6 +1071,7 @@ ProcWrongNumArgs(
|
||||
{
|
||||
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
|
||||
register Proc *procPtr = framePtr->procPtr;
|
||||
register Var *defPtr;
|
||||
int localCt = procPtr->numCompiledLocals, numArgs, i;
|
||||
Tcl_Obj **desiredObjs;
|
||||
const char *final = NULL;
|
||||
@@ -1054,26 +1095,23 @@ ProcWrongNumArgs(
|
||||
}
|
||||
Tcl_IncrRefCount(desiredObjs[0]);
|
||||
|
||||
if (localCt > 0) {
|
||||
register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
|
||||
defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
|
||||
for (i=1 ; i<=numArgs ; i++, defPtr++) {
|
||||
Tcl_Obj *argObj;
|
||||
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
||||
|
||||
for (i=1 ; i<=numArgs ; i++, defPtr++) {
|
||||
Tcl_Obj *argObj;
|
||||
Tcl_Obj *namePtr = localName(framePtr, i-1);
|
||||
|
||||
if (defPtr->value.objPtr != NULL) {
|
||||
TclNewObj(argObj);
|
||||
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
|
||||
} else if (defPtr->flags & VAR_IS_ARGS) {
|
||||
numArgs--;
|
||||
final = "?arg ...?";
|
||||
break;
|
||||
} else {
|
||||
argObj = namePtr;
|
||||
Tcl_IncrRefCount(namePtr);
|
||||
}
|
||||
desiredObjs[i] = argObj;
|
||||
if (defPtr->value.objPtr != NULL) {
|
||||
TclNewObj(argObj);
|
||||
Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
|
||||
} else if (defPtr->flags & VAR_IS_ARGS) {
|
||||
numArgs--;
|
||||
final = "?arg ...?";
|
||||
break;
|
||||
} else {
|
||||
argObj = namePtr;
|
||||
Tcl_IncrRefCount(namePtr);
|
||||
}
|
||||
desiredObjs[i] = argObj;
|
||||
}
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
+4
-12
@@ -134,7 +134,7 @@ BuildCharSet(
|
||||
* as well as the dash.
|
||||
*/
|
||||
|
||||
if (*format == ']' || !cset->ranges) {
|
||||
if (*format == ']') {
|
||||
cset->chars[cset->nchars++] = start;
|
||||
cset->chars[cset->nchars++] = ch;
|
||||
} else {
|
||||
@@ -260,7 +260,7 @@ ValidateFormat(
|
||||
Tcl_UniChar ch = 0;
|
||||
int objIndex, xpgSize, nspace = numVars;
|
||||
int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
|
||||
char buf[TCL_UTF_MAX+1] = "";
|
||||
char buf[TCL_UTF_MAX+1];
|
||||
Tcl_Obj *errorMsg; /* Place to build an error messages. Note that
|
||||
* these are messy operations because we do
|
||||
* not want to use the formatting engine;
|
||||
@@ -885,17 +885,9 @@ Tcl_ScanObjCmd(
|
||||
* Scan a single Unicode character.
|
||||
*/
|
||||
|
||||
offset = TclUtfToUniChar(string, &sch);
|
||||
i = (int)sch;
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((sch >= 0xD800) && (offset < 3)) {
|
||||
offset += TclUtfToUniChar(string+offset, &sch);
|
||||
i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
|
||||
}
|
||||
#endif
|
||||
string += offset;
|
||||
string += TclUtfToUniChar(string, &sch);
|
||||
if (!(flags & SCAN_SUPPRESS)) {
|
||||
objPtr = Tcl_NewIntObj(i);
|
||||
objPtr = Tcl_NewIntObj((int)sch);
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
CLANG_ASSERT(objs);
|
||||
objs[objIndex++] = objPtr;
|
||||
|
||||
+9
-80
@@ -418,23 +418,18 @@ Tcl_GetCharLength(
|
||||
int numChars;
|
||||
|
||||
/*
|
||||
* Optimize the case where we're really dealing with a bytearray object;
|
||||
* we don't need to convert to a string to perform the get-length operation.
|
||||
*
|
||||
* NOTE that we do not need the bytearray to be "pure". A ByteArray value
|
||||
* with a string rep cannot be trusted to represent the same value as the
|
||||
* string rep, but it *can* be trusted to have the same character length
|
||||
* as the string rep, which is all this routine cares about.
|
||||
* Optimize the case where we're really dealing with a bytearray object
|
||||
* without string representation; we don't need to convert to a string to
|
||||
* perform the get-length operation.
|
||||
*/
|
||||
|
||||
if (objPtr->typePtr == &tclByteArrayType) {
|
||||
if (TclIsPureByteArray(objPtr)) {
|
||||
int length;
|
||||
|
||||
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
|
||||
return length;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* OK, need to work with the object as a string.
|
||||
*/
|
||||
@@ -465,50 +460,6 @@ Tcl_GetCharLength(
|
||||
}
|
||||
return numChars;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCheckEmptyString --
|
||||
*
|
||||
* Determine whether the string value of an object is or would be the
|
||||
* empty string, without generating a string representation.
|
||||
*
|
||||
* Results:
|
||||
* Returns 1 if empty, 0 if not, and -1 if unknown.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
int
|
||||
TclCheckEmptyString (
|
||||
Tcl_Obj *objPtr
|
||||
) {
|
||||
int length = -1;
|
||||
|
||||
if (objPtr->bytes == tclEmptyStringRep) {
|
||||
return TCL_EMPTYSTRING_YES;
|
||||
}
|
||||
|
||||
if (TclIsPureList(objPtr)) {
|
||||
Tcl_ListObjLength(NULL, objPtr, &length);
|
||||
return length == 0;
|
||||
}
|
||||
|
||||
if (TclIsPureDict(objPtr)) {
|
||||
Tcl_DictObjSize(NULL, objPtr, &length);
|
||||
return length == 0;
|
||||
}
|
||||
|
||||
if (objPtr->bytes == NULL) {
|
||||
return TCL_EMPTYSTRING_UNKNOWN;
|
||||
}
|
||||
return objPtr->length == 0;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -578,7 +529,7 @@ Tcl_GetUniChar(
|
||||
*
|
||||
* Get the Unicode form of the String object. If the object is not
|
||||
* already a String object, it will be converted to one. If the String
|
||||
* object does not have a Unicode rep, then one is created from the UTF
|
||||
* object does not have a Unicode rep, then one is create from the UTF
|
||||
* string format.
|
||||
*
|
||||
* Results:
|
||||
@@ -712,17 +663,6 @@ Tcl_GetRange(
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
}
|
||||
|
||||
#if TCL_UTF_MAX == 4
|
||||
/* See: bug [11ae2be95dac9417] */
|
||||
if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
|
||||
&& ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
|
||||
++first;
|
||||
}
|
||||
if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
|
||||
&& ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
|
||||
++last;
|
||||
}
|
||||
#endif
|
||||
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
|
||||
}
|
||||
|
||||
@@ -1876,11 +1816,6 @@ Tcl_AppendFormatToObj(
|
||||
width = 0;
|
||||
if (isdigit(UCHAR(ch))) {
|
||||
width = strtoul(format, &end, 10);
|
||||
if (width < 0) {
|
||||
msg = overflow;
|
||||
errCode = "OVERFLOW";
|
||||
goto errorMsg;
|
||||
}
|
||||
format = end;
|
||||
step = TclUtfToUniChar(format, &ch);
|
||||
} else if (ch == '*') {
|
||||
@@ -2001,12 +1936,6 @@ Tcl_AppendFormatToObj(
|
||||
goto error;
|
||||
}
|
||||
length = Tcl_UniCharToUtf(code, buf);
|
||||
#if TCL_UTF_MAX > 3
|
||||
if ((code >= 0xD800) && (length < 3)) {
|
||||
/* Special case for handling high surrogates. */
|
||||
length += Tcl_UniCharToUtf(-1, buf + length);
|
||||
}
|
||||
#endif
|
||||
segment = Tcl_NewStringObj(buf, length);
|
||||
Tcl_IncrRefCount(segment);
|
||||
allocSegment = 1;
|
||||
@@ -2791,6 +2720,7 @@ TclStringObjReverse(
|
||||
* Tcl_SetObjLength into growing the unicode rep buffer.
|
||||
*/
|
||||
|
||||
ch = 0;
|
||||
objPtr = Tcl_NewUnicodeObj(&ch, 1);
|
||||
Tcl_SetObjLength(objPtr, stringPtr->numChars);
|
||||
to = Tcl_GetUnicode(objPtr);
|
||||
@@ -2893,7 +2823,7 @@ ExtendUnicodeRepWithString(
|
||||
{
|
||||
String *stringPtr = GET_STRING(objPtr);
|
||||
int needed, numOrigChars = 0;
|
||||
Tcl_UniChar *dst, unichar = 0;
|
||||
Tcl_UniChar *dst;
|
||||
|
||||
if (stringPtr->hasUnicode) {
|
||||
numOrigChars = stringPtr->numChars;
|
||||
@@ -2916,8 +2846,7 @@ ExtendUnicodeRepWithString(
|
||||
numAppendChars = 0;
|
||||
}
|
||||
for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
|
||||
bytes += TclUtfToUniChar(bytes, &unichar);
|
||||
*dst = unichar;
|
||||
bytes += TclUtfToUniChar(bytes, dst);
|
||||
}
|
||||
*dst = 0;
|
||||
}
|
||||
@@ -3176,7 +3105,7 @@ ExtendStringRepWithUnicode(
|
||||
copyBytes:
|
||||
dst = objPtr->bytes + origLength;
|
||||
for (i = 0; i < numChars; i++) {
|
||||
dst += Tcl_UniCharToUtf(unicode[i], dst);
|
||||
dst += Tcl_UniCharToUtf((int) unicode[i], dst);
|
||||
}
|
||||
*dst = '\0';
|
||||
objPtr->length = dst - objPtr->bytes;
|
||||
|
||||
+11
-111
@@ -12,10 +12,6 @@
|
||||
#include "tclInt.h"
|
||||
#include "tommath.h"
|
||||
|
||||
#ifdef __CYGWIN__
|
||||
# include <wchar.h>
|
||||
#endif
|
||||
|
||||
#ifdef __GNUC__
|
||||
#pragma GCC dependency "tcl.decls"
|
||||
#pragma GCC dependency "tclInt.decls"
|
||||
@@ -110,6 +106,8 @@ static unsigned short TclWinNToHS(unsigned short ns) {
|
||||
# define TclWinFlushDirtyChannels doNothing
|
||||
# define TclWinResetInterfaces doNothing
|
||||
|
||||
static Tcl_Encoding winTCharEncoding;
|
||||
|
||||
static int
|
||||
TclpIsAtty(int fd)
|
||||
{
|
||||
@@ -129,7 +127,7 @@ void *TclWinGetTclInstance()
|
||||
{
|
||||
void *hInstance = NULL;
|
||||
GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
|
||||
(const char *)&TclpIsAtty, &hInstance);
|
||||
(const char *)&winTCharEncoding, &hInstance);
|
||||
return hInstance;
|
||||
}
|
||||
|
||||
@@ -188,68 +186,11 @@ Tcl_WinUtfToTChar(
|
||||
int len,
|
||||
Tcl_DString *dsPtr)
|
||||
{
|
||||
#if TCL_UTF_MAX > 4
|
||||
Tcl_UniChar ch = 0;
|
||||
wchar_t *w, *wString;
|
||||
const char *p, *end;
|
||||
int oldLength;
|
||||
#endif
|
||||
|
||||
Tcl_DStringInit(dsPtr);
|
||||
if (!string) {
|
||||
return NULL;
|
||||
if (!winTCharEncoding) {
|
||||
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
|
||||
}
|
||||
#if TCL_UTF_MAX > 4
|
||||
|
||||
if (len < 0) {
|
||||
len = strlen(string);
|
||||
}
|
||||
|
||||
/*
|
||||
* Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
|
||||
* bytes.
|
||||
*/
|
||||
|
||||
oldLength = Tcl_DStringLength(dsPtr);
|
||||
|
||||
Tcl_DStringSetLength(dsPtr,
|
||||
oldLength + (int) ((len + 1) * sizeof(wchar_t)));
|
||||
wString = (wchar_t *) (Tcl_DStringValue(dsPtr) + oldLength);
|
||||
|
||||
w = wString;
|
||||
p = string;
|
||||
end = string + len - 4;
|
||||
while (p < end) {
|
||||
p += TclUtfToUniChar(p, &ch);
|
||||
if (ch > 0xFFFF) {
|
||||
*w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10));
|
||||
*w++ = (wchar_t) (0xDC00 | (ch & 0x3FF));
|
||||
} else {
|
||||
*w++ = ch;
|
||||
}
|
||||
}
|
||||
end += 4;
|
||||
while (p < end) {
|
||||
if (Tcl_UtfCharComplete(p, end-p)) {
|
||||
p += TclUtfToUniChar(p, &ch);
|
||||
} else {
|
||||
ch = UCHAR(*p++);
|
||||
}
|
||||
if (ch > 0xFFFF) {
|
||||
*w++ = (wchar_t) (0xD800 + ((ch -= 0x10000) >> 10));
|
||||
*w++ = (wchar_t) (0xDC00 | (ch & 0x3FF));
|
||||
} else {
|
||||
*w++ = ch;
|
||||
}
|
||||
}
|
||||
*w = '\0';
|
||||
Tcl_DStringSetLength(dsPtr,
|
||||
oldLength + ((char *) w - (char *) wString));
|
||||
|
||||
return (char *)wString;
|
||||
#else
|
||||
return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
|
||||
#endif
|
||||
return Tcl_UtfToExternalDString(winTCharEncoding,
|
||||
string, len, dsPtr);
|
||||
}
|
||||
|
||||
char *
|
||||
@@ -258,51 +199,11 @@ Tcl_WinTCharToUtf(
|
||||
int len,
|
||||
Tcl_DString *dsPtr)
|
||||
{
|
||||
#if TCL_UTF_MAX > 4
|
||||
const wchar_t *w, *wEnd;
|
||||
char *p, *result;
|
||||
int oldLength, blen = 1;
|
||||
#endif
|
||||
|
||||
Tcl_DStringInit(dsPtr);
|
||||
if (!string) {
|
||||
return NULL;
|
||||
if (!winTCharEncoding) {
|
||||
winTCharEncoding = Tcl_GetEncoding(0, "unicode");
|
||||
}
|
||||
if (len < 0) {
|
||||
len = wcslen((wchar_t *)string);
|
||||
} else {
|
||||
len /= 2;
|
||||
}
|
||||
#if TCL_UTF_MAX > 4
|
||||
oldLength = Tcl_DStringLength(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, oldLength + (len + 1) * 4);
|
||||
result = Tcl_DStringValue(dsPtr) + oldLength;
|
||||
|
||||
p = result;
|
||||
wEnd = (wchar_t *)string + len;
|
||||
for (w = (wchar_t *)string; w < wEnd; ) {
|
||||
if (!blen && ((*w & 0xFC00) != 0xDC00)) {
|
||||
/* Special case for handling high surrogates. */
|
||||
p += Tcl_UniCharToUtf(-1, p);
|
||||
}
|
||||
blen = Tcl_UniCharToUtf(*w, p);
|
||||
p += blen;
|
||||
if ((*w >= 0xD800) && (blen < 3)) {
|
||||
/* Indication that high surrogate is handled */
|
||||
blen = 0;
|
||||
}
|
||||
w++;
|
||||
}
|
||||
if (!blen) {
|
||||
/* Special case for handling high surrogates. */
|
||||
p += Tcl_UniCharToUtf(-1, p);
|
||||
}
|
||||
Tcl_DStringSetLength(dsPtr, oldLength + (p - result));
|
||||
|
||||
return result;
|
||||
#else
|
||||
return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
|
||||
#endif
|
||||
return Tcl_ExternalToUtfDString(winTCharEncoding,
|
||||
string, len, dsPtr);
|
||||
}
|
||||
|
||||
#if defined(TCL_WIDE_INT_IS_LONG)
|
||||
@@ -853,7 +754,6 @@ const TclTomMathStubs tclTomMathStubs = {
|
||||
TclBNInitBignumFromLong, /* 64 */
|
||||
TclBNInitBignumFromWideInt, /* 65 */
|
||||
TclBNInitBignumFromWideUInt, /* 66 */
|
||||
TclBN_mp_expt_d_ex, /* 67 */
|
||||
};
|
||||
|
||||
static const TclStubHooks tclStubHooks = {
|
||||
|
||||
+4
-113
@@ -220,9 +220,6 @@ static void SpecialFree(char *blockPtr);
|
||||
static int StaticInitProc(Tcl_Interp *interp);
|
||||
static int TestasyncCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int argc, const char **argv);
|
||||
static int TestpurebytesobjObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int TestbytestringObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -410,12 +407,6 @@ static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
|
||||
static int TestNumUtfCharsCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int TestFindFirstCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int TestFindLastCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
static int TestHashSystemHashCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -573,7 +564,6 @@ Tcltest_Init(
|
||||
Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
|
||||
NULL, NULL);
|
||||
@@ -678,10 +668,6 @@ Tcltest_Init(
|
||||
TestsetobjerrorcodeCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testnumutfchars",
|
||||
TestNumUtfCharsCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testfindfirst",
|
||||
TestFindFirstCmd, NULL, NULL);
|
||||
Tcl_CreateObjCommand(interp, "testfindlast",
|
||||
TestFindLastCmd, NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
|
||||
@@ -2085,7 +2071,7 @@ TestevalexObjCmd(
|
||||
|
||||
flags = 0;
|
||||
if (objc == 3) {
|
||||
const char *global = Tcl_GetString(objv[2]);
|
||||
const char *global = Tcl_GetStringFromObj(objv[2], &length);
|
||||
if (strcmp(global, "global") != 0) {
|
||||
Tcl_AppendResult(interp, "bad value \"", global,
|
||||
"\": must be global", NULL);
|
||||
@@ -4960,57 +4946,6 @@ NoopObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TestpurebytesobjObjCmd --
|
||||
*
|
||||
* This object-based procedure constructs a pure bytes object
|
||||
* without type and with internal representation containing NULL's.
|
||||
*
|
||||
* If no argument supplied it returns empty object with tclEmptyStringRep,
|
||||
* otherwise it returns this as pure bytes object with bytes value equal
|
||||
* string.
|
||||
*
|
||||
* Results:
|
||||
* Returns the TCL_OK result code.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
TestpurebytesobjObjCmd(
|
||||
ClientData unused, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||||
{
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
if (objc > 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "?string?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
objPtr = Tcl_NewObj();
|
||||
/*
|
||||
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
|
||||
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
|
||||
*/
|
||||
memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
|
||||
if (objc == 2) {
|
||||
const char *s = Tcl_GetString(objv[1]);
|
||||
objPtr->length = objv[1]->length;
|
||||
objPtr->bytes = ckalloc(objPtr->length + 1);
|
||||
memcpy(objPtr->bytes, s, objPtr->length);
|
||||
objPtr->bytes[objPtr->length] = 0;
|
||||
}
|
||||
Tcl_SetObjResult(interp, objPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -5289,7 +5224,7 @@ TestmainthreadCmd(
|
||||
const char **argv) /* Argument strings. */
|
||||
{
|
||||
if (argc == 1) {
|
||||
Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
|
||||
Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());
|
||||
|
||||
Tcl_SetObjResult(interp, idObj);
|
||||
return TCL_OK;
|
||||
@@ -5686,8 +5621,8 @@ TestChannelCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
|
||||
(Tcl_WideInt) (size_t) Tcl_GetChannelThread(chan)));
|
||||
TclFormatInt(buf, (size_t) Tcl_GetChannelThread(chan));
|
||||
Tcl_AppendResult(interp, buf, NULL);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -6745,50 +6680,6 @@ TestNumUtfCharsCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Used to check correct operation of Tcl_UtfFindFirst
|
||||
*/
|
||||
|
||||
static int
|
||||
TestFindFirstCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
if (objc > 1) {
|
||||
int len = -1;
|
||||
|
||||
if (objc > 2) {
|
||||
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Used to check correct operation of Tcl_UtfFindLast
|
||||
*/
|
||||
|
||||
static int
|
||||
TestFindLastCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
if (objc > 1) {
|
||||
int len = -1;
|
||||
|
||||
if (objc > 2) {
|
||||
(void) Tcl_GetIntFromObj(interp, objv[2], &len);
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
#if defined(HAVE_CPUID) || defined(_WIN32)
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
|
||||
@@ -21,14 +21,13 @@
|
||||
*/
|
||||
|
||||
static const char packageName[] = "procbodytest";
|
||||
static const char packageVersion[] = "1.1";
|
||||
static const char packageVersion[] = "1.0";
|
||||
|
||||
/*
|
||||
* Name of the commands exported by this package
|
||||
*/
|
||||
|
||||
static const char procCommand[] = "proc";
|
||||
static const char checkCommand[] = "check";
|
||||
|
||||
/*
|
||||
* this struct describes an entry in the table of command names and command
|
||||
@@ -47,8 +46,6 @@ typedef struct CmdTable {
|
||||
|
||||
static int ProcBodyTestProcObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
static int ProcBodyTestCheckObjCmd(ClientData dummy,
|
||||
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
|
||||
static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
|
||||
static int RegisterCommand(Tcl_Interp* interp,
|
||||
const char *namespace, const CmdTable *cmdTablePtr);
|
||||
@@ -60,13 +57,11 @@ static int RegisterCommand(Tcl_Interp* interp,
|
||||
|
||||
static const CmdTable commands[] = {
|
||||
{ procCommand, ProcBodyTestProcObjCmd, 1 },
|
||||
{ checkCommand, ProcBodyTestCheckObjCmd, 1 },
|
||||
{ 0, 0, 0 }
|
||||
};
|
||||
|
||||
static const CmdTable safeCommands[] = {
|
||||
{ procCommand, ProcBodyTestProcObjCmd, 1 },
|
||||
{ checkCommand, ProcBodyTestCheckObjCmd, 1 },
|
||||
{ 0, 0, 0 }
|
||||
};
|
||||
|
||||
@@ -305,46 +300,6 @@ ProcBodyTestProcObjCmd(
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* ProcBodyTestCheckObjCmd --
|
||||
*
|
||||
* Implements the "procbodytest::check" command. Here is the command
|
||||
* description:
|
||||
* procbodytest::check
|
||||
*
|
||||
* Performs an internal check that the Tcl_PkgPresent() command returns
|
||||
* the same version number as was registered when the procbodytest package
|
||||
* was provided. Places a boolean in the interp result indicating the
|
||||
* test outcome.
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl code.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
ProcBodyTestCheckObjCmd(
|
||||
ClientData dummy, /* context; not used */
|
||||
Tcl_Interp *interp, /* the current interpreter */
|
||||
int objc, /* argument count */
|
||||
Tcl_Obj *const objv[]) /* arguments */
|
||||
{
|
||||
const char *version;
|
||||
|
||||
if (objc != 1) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
|
||||
strcmp(version, packageVersion) == 0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
|
||||
+3
-10
@@ -174,6 +174,7 @@ TclThread_Init(
|
||||
Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -247,7 +248,7 @@ ThreadObjCmd(
|
||||
|
||||
switch ((enum options)option) {
|
||||
case THREAD_CANCEL: {
|
||||
Tcl_WideInt id;
|
||||
long id;
|
||||
const char *result;
|
||||
int flags, arg;
|
||||
|
||||
@@ -263,7 +264,7 @@ ThreadObjCmd(
|
||||
arg++;
|
||||
}
|
||||
}
|
||||
if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
|
||||
if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
arg++;
|
||||
@@ -1157,14 +1158,6 @@ ThreadExitProc(
|
||||
|
||||
Tcl_MutexLock(&threadMutex);
|
||||
|
||||
if (self == errorThreadId) {
|
||||
if (errorProcString) { /* Extra safety */
|
||||
ckfree(errorProcString);
|
||||
errorProcString = NULL;
|
||||
}
|
||||
errorThreadId = 0;
|
||||
}
|
||||
|
||||
if (threadEvalScript) {
|
||||
ckfree(threadEvalScript);
|
||||
threadEvalScript = NULL;
|
||||
|
||||
+34
-39
@@ -30,13 +30,13 @@ declare 1 {
|
||||
}
|
||||
|
||||
declare 2 {
|
||||
int TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 3 {
|
||||
int TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c)
|
||||
int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
|
||||
}
|
||||
declare 4 {
|
||||
int TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 5 {
|
||||
void TclBN_mp_clamp(mp_int *a)
|
||||
@@ -63,25 +63,25 @@ declare 12 {
|
||||
int TclBN_mp_count_bits(const mp_int *a)
|
||||
}
|
||||
declare 13 {
|
||||
int TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r)
|
||||
int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
|
||||
}
|
||||
declare 14 {
|
||||
int TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
|
||||
int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
|
||||
}
|
||||
declare 15 {
|
||||
int TclBN_mp_div_2(const mp_int *a, mp_int *q)
|
||||
int TclBN_mp_div_2(mp_int *a, mp_int *q)
|
||||
}
|
||||
declare 16 {
|
||||
int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
|
||||
}
|
||||
declare 17 {
|
||||
int TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r)
|
||||
int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
|
||||
}
|
||||
declare 18 {
|
||||
void TclBN_mp_exch(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 19 {
|
||||
int TclBN_mp_expt_d(const mp_int *a, mp_digit b, mp_int *c)
|
||||
int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
|
||||
}
|
||||
declare 20 {
|
||||
int TclBN_mp_grow(mp_int *a, int size)
|
||||
@@ -90,7 +90,7 @@ declare 21 {
|
||||
int TclBN_mp_init(mp_int *a)
|
||||
}
|
||||
declare 22 {
|
||||
int TclBN_mp_init_copy(mp_int *a, const mp_int *b)
|
||||
int TclBN_mp_init_copy(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 23 {
|
||||
int TclBN_mp_init_multi(mp_int *a, ...)
|
||||
@@ -105,19 +105,19 @@ declare 26 {
|
||||
int TclBN_mp_lshd(mp_int *a, int shift)
|
||||
}
|
||||
declare 27 {
|
||||
int TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r)
|
||||
int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
|
||||
}
|
||||
declare 28 {
|
||||
int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r)
|
||||
}
|
||||
declare 29 {
|
||||
int TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p)
|
||||
int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
|
||||
}
|
||||
declare 30 {
|
||||
int TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p)
|
||||
int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
|
||||
}
|
||||
declare 31 {
|
||||
int TclBN_mp_mul_2(const mp_int *a, mp_int *p)
|
||||
int TclBN_mp_mul_2(mp_int *a, mp_int *p)
|
||||
}
|
||||
declare 32 {
|
||||
int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
|
||||
@@ -126,10 +126,10 @@ declare 33 {
|
||||
int TclBN_mp_neg(const mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 34 {
|
||||
int TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 35 {
|
||||
int TclBN_mp_radix_size(const mp_int *a, int radix, int *size)
|
||||
int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
|
||||
}
|
||||
declare 36 {
|
||||
int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
|
||||
@@ -144,32 +144,32 @@ declare 39 {
|
||||
void TclBN_mp_set(mp_int *a, mp_digit b)
|
||||
}
|
||||
declare 40 {
|
||||
int TclBN_mp_sqr(const mp_int *a, mp_int *b)
|
||||
int TclBN_mp_sqr(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 41 {
|
||||
int TclBN_mp_sqrt(const mp_int *a, mp_int *b)
|
||||
int TclBN_mp_sqrt(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 42 {
|
||||
int TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 43 {
|
||||
int TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c)
|
||||
int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
|
||||
}
|
||||
declare 44 {
|
||||
int TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
|
||||
int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
|
||||
}
|
||||
declare 45 {
|
||||
int TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b,
|
||||
int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
|
||||
unsigned long *outlen)
|
||||
}
|
||||
declare 46 {
|
||||
int TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
|
||||
int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
|
||||
}
|
||||
declare 47 {
|
||||
int TclBN_mp_unsigned_bin_size(const mp_int *a)
|
||||
int TclBN_mp_unsigned_bin_size(mp_int *a)
|
||||
}
|
||||
declare 48 {
|
||||
int TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 49 {
|
||||
void TclBN_mp_zero(mp_int *a)
|
||||
@@ -182,34 +182,34 @@ declare 50 {
|
||||
void TclBN_reverse(unsigned char *s, int len)
|
||||
}
|
||||
declare 51 {
|
||||
int TclBN_fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
|
||||
int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
|
||||
}
|
||||
declare 52 {
|
||||
int TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b)
|
||||
int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 53 {
|
||||
int TclBN_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 54 {
|
||||
int TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b)
|
||||
int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 55 {
|
||||
int TclBN_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 56 {
|
||||
int TclBN_mp_toom_sqr(const mp_int *a, mp_int *b)
|
||||
int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 57 {
|
||||
int TclBN_s_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 58 {
|
||||
int TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
|
||||
int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
|
||||
}
|
||||
declare 59 {
|
||||
int TclBN_s_mp_sqr(const mp_int *a, mp_int *b)
|
||||
int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
|
||||
}
|
||||
declare 60 {
|
||||
int TclBN_s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
|
||||
int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
|
||||
}
|
||||
declare 61 {
|
||||
int TclBN_mp_init_set_int(mp_int *a, unsigned long i)
|
||||
@@ -233,11 +233,6 @@ declare 66 {
|
||||
void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
|
||||
}
|
||||
|
||||
# Added in libtommath 1.0
|
||||
declare 67 {
|
||||
int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
|
||||
}
|
||||
|
||||
# Local Variables:
|
||||
# mode: tcl
|
||||
# End:
|
||||
|
||||
+233
-229
@@ -9,6 +9,8 @@
|
||||
*
|
||||
* The library is free for all purposes without any express
|
||||
* guarantee it works.
|
||||
*
|
||||
* Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
|
||||
*/
|
||||
#ifndef BN_H_
|
||||
#define BN_H_
|
||||
@@ -20,25 +22,32 @@
|
||||
|
||||
|
||||
|
||||
#ifndef MIN
|
||||
# define MIN(x,y) ((x)<(y)?(x):(y))
|
||||
#endif
|
||||
|
||||
#ifndef MAX
|
||||
# define MAX(x,y) ((x)>(y)?(x):(y))
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
|
||||
/* C++ compilers don't like assigning void * to mp_digit * */
|
||||
#define OPT_CAST(x) (x *)
|
||||
|
||||
#else
|
||||
|
||||
/* C on the other hand doesn't care */
|
||||
#define OPT_CAST(x)
|
||||
|
||||
#endif
|
||||
|
||||
/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
|
||||
#if defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)
|
||||
# define MP_32BIT
|
||||
#endif
|
||||
|
||||
/* detect 64-bit mode if possible */
|
||||
#if defined(NEVER)
|
||||
# if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
|
||||
# if defined(__GNUC__)
|
||||
/* we support 128bit integers only via: __attribute__((mode(TI))) */
|
||||
# define MP_64BIT
|
||||
# else
|
||||
/* otherwise we fall back to MP_32BIT even on 64bit platforms */
|
||||
# define MP_32BIT
|
||||
# endif
|
||||
#if defined(NEVER) /* 128-bit ints fail in too many places */
|
||||
# if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
|
||||
# define MP_64BIT
|
||||
# endif
|
||||
#endif
|
||||
|
||||
@@ -52,67 +61,83 @@ extern "C" {
|
||||
*/
|
||||
#ifdef MP_8BIT
|
||||
#ifndef MP_DIGIT_DECLARED
|
||||
typedef unsigned char mp_digit;
|
||||
typedef unsigned char mp_digit;
|
||||
#define MP_DIGIT_DECLARED
|
||||
#endif
|
||||
#ifndef MP_WORD_DECLARED
|
||||
typedef unsigned short mp_word;
|
||||
#define MP_WORD_DECLARED
|
||||
#endif
|
||||
# define MP_SIZEOF_MP_DIGIT 1
|
||||
# ifdef DIGIT_BIT
|
||||
# error You must not define DIGIT_BIT when using MP_8BIT
|
||||
# endif
|
||||
typedef unsigned short mp_word;
|
||||
#elif defined(MP_16BIT)
|
||||
#ifndef MP_DIGIT_DECLARED
|
||||
typedef unsigned short mp_digit;
|
||||
typedef unsigned short mp_digit;
|
||||
#define MP_DIGIT_DECLARED
|
||||
#endif
|
||||
#ifndef MP_WORD_DECLARED
|
||||
typedef unsigned int mp_word;
|
||||
#define MP_WORD_DECLARED
|
||||
#endif
|
||||
# define MP_SIZEOF_MP_DIGIT 2
|
||||
# ifdef DIGIT_BIT
|
||||
# error You must not define DIGIT_BIT when using MP_16BIT
|
||||
# endif
|
||||
typedef unsigned long mp_word;
|
||||
#elif defined(MP_64BIT)
|
||||
/* for GCC only on supported platforms */
|
||||
/* for GCC only on supported platforms */
|
||||
#ifndef CRYPT
|
||||
typedef unsigned long long ulong64;
|
||||
typedef signed long long long64;
|
||||
#endif
|
||||
|
||||
#ifndef MP_DIGIT_DECLARED
|
||||
typedef unsigned long long mp_digit;
|
||||
typedef unsigned long mp_digit;
|
||||
#define MP_DIGIT_DECLARED
|
||||
#endif
|
||||
typedef unsigned long mp_word __attribute__((mode(TI)));
|
||||
# define DIGIT_BIT 60
|
||||
typedef unsigned long mp_word __attribute__ ((mode(TI)));
|
||||
|
||||
# define DIGIT_BIT 60
|
||||
#else
|
||||
/* this is the default case, 28-bit digits */
|
||||
/* this is the default case, 28-bit digits */
|
||||
|
||||
/* this is to make porting into LibTomCrypt easier :-) */
|
||||
#ifndef CRYPT
|
||||
# if defined(_MSC_VER) || defined(__BORLANDC__)
|
||||
typedef unsigned __int64 ulong64;
|
||||
typedef signed __int64 long64;
|
||||
# else
|
||||
typedef unsigned long long ulong64;
|
||||
typedef signed long long long64;
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* this is to make porting into LibTomCrypt easier :-) */
|
||||
#ifndef MP_DIGIT_DECLARED
|
||||
typedef unsigned int mp_digit;
|
||||
typedef unsigned int mp_digit;
|
||||
#define MP_DIGIT_DECLARED
|
||||
#endif
|
||||
#ifndef MP_WORD_DECLARED
|
||||
typedef unsigned long long mp_word;
|
||||
#define MP_WORD_DECLARED
|
||||
typedef ulong64 mp_word;
|
||||
|
||||
#ifdef MP_31BIT
|
||||
/* this is an extension that uses 31-bit digits */
|
||||
# define DIGIT_BIT 31
|
||||
#else
|
||||
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
|
||||
# define DIGIT_BIT 28
|
||||
# define MP_28BIT
|
||||
#endif
|
||||
#endif
|
||||
|
||||
# ifdef MP_31BIT
|
||||
/* this is an extension that uses 31-bit digits */
|
||||
# define DIGIT_BIT 31
|
||||
# else
|
||||
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
|
||||
# define DIGIT_BIT 28
|
||||
# define MP_28BIT
|
||||
# endif
|
||||
/* define heap macros */
|
||||
#if 0 /* these are macros in tclTomMathDecls.h */
|
||||
#ifndef CRYPT
|
||||
/* default to libc stuff */
|
||||
# ifndef XMALLOC
|
||||
# define XMALLOC malloc
|
||||
# define XFREE free
|
||||
# define XREALLOC realloc
|
||||
# define XCALLOC calloc
|
||||
# else
|
||||
/* prototypes for our heap functions */
|
||||
extern void *XMALLOC(size_t n);
|
||||
extern void *XREALLOC(void *p, size_t n);
|
||||
extern void *XCALLOC(size_t n, size_t s);
|
||||
extern void XFREE(void *p);
|
||||
# endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
|
||||
/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
|
||||
#ifndef DIGIT_BIT
|
||||
# define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1)) /* bits per digit */
|
||||
typedef unsigned long mp_min_u32;
|
||||
#else
|
||||
typedef mp_digit mp_min_u32;
|
||||
# define DIGIT_BIT ((int)((CHAR_BIT * sizeof(mp_digit) - 1))) /* bits per digit */
|
||||
#endif
|
||||
|
||||
#define MP_DIGIT_BIT DIGIT_BIT
|
||||
@@ -145,9 +170,9 @@ typedef int mp_err;
|
||||
/* you'll have to tune these... */
|
||||
#if defined(BUILD_tcl) || !defined(_WIN32)
|
||||
MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
|
||||
KARATSUBA_SQR_CUTOFF,
|
||||
TOOM_MUL_CUTOFF,
|
||||
TOOM_SQR_CUTOFF;
|
||||
KARATSUBA_SQR_CUTOFF,
|
||||
TOOM_MUL_CUTOFF,
|
||||
TOOM_SQR_CUTOFF;
|
||||
#endif
|
||||
|
||||
/* define this to use lower memory usage routines (exptmods mostly) */
|
||||
@@ -155,15 +180,15 @@ MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
|
||||
|
||||
/* default precision */
|
||||
#ifndef MP_PREC
|
||||
# ifndef MP_LOW_MEM
|
||||
# define MP_PREC 32 /* default digits of precision */
|
||||
# else
|
||||
# define MP_PREC 8 /* default digits of precision */
|
||||
# endif
|
||||
# ifndef MP_LOW_MEM
|
||||
# define MP_PREC 32 /* default digits of precision */
|
||||
# else
|
||||
# define MP_PREC 8 /* default digits of precision */
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
|
||||
#define MP_WARRAY (1u << (((sizeof(mp_word) * CHAR_BIT) - (2 * DIGIT_BIT)) + 1))
|
||||
#define MP_WARRAY (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
|
||||
|
||||
/* the infamous mp_int structure */
|
||||
#ifndef MP_INT_DECLARED
|
||||
@@ -171,20 +196,22 @@ MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
|
||||
typedef struct mp_int mp_int;
|
||||
#endif
|
||||
struct mp_int {
|
||||
int used, alloc, sign;
|
||||
mp_digit *dp;
|
||||
int used, alloc, sign;
|
||||
mp_digit *dp;
|
||||
};
|
||||
|
||||
/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
|
||||
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);
|
||||
|
||||
|
||||
#define USED(m) ((m)->used)
|
||||
#define DIGIT(m, k) ((m)->dp[(k)])
|
||||
#define SIGN(m) ((m)->sign)
|
||||
#define USED(m) ((m)->used)
|
||||
#define DIGIT(m,k) ((m)->dp[(k)])
|
||||
#define SIGN(m) ((m)->sign)
|
||||
|
||||
/* error code to char* string */
|
||||
const char *mp_error_to_string(int code);
|
||||
/*
|
||||
char *mp_error_to_string(int code);
|
||||
*/
|
||||
|
||||
/* ---> init and deinit bignum functions <--- */
|
||||
/* init a bignum */
|
||||
@@ -229,9 +256,8 @@ int mp_init_size(mp_int *a, int size);
|
||||
|
||||
/* ---> Basic Manipulations <--- */
|
||||
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
|
||||
#define mp_iseven(a) ((((a)->used == 0) || (((a)->dp[0] & 1u) == 0u)) ? MP_YES : MP_NO)
|
||||
#define mp_isodd(a) ((((a)->used > 0) && (((a)->dp[0] & 1u) == 1u)) ? MP_YES : MP_NO)
|
||||
#define mp_isneg(a) (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)
|
||||
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
|
||||
#define mp_isodd(a) (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
|
||||
|
||||
/* set to zero */
|
||||
/*
|
||||
@@ -248,39 +274,17 @@ void mp_set(mp_int *a, mp_digit b);
|
||||
int mp_set_int(mp_int *a, unsigned long b);
|
||||
*/
|
||||
|
||||
/* set a platform dependent unsigned long value */
|
||||
/*
|
||||
int mp_set_long(mp_int *a, unsigned long b);
|
||||
*/
|
||||
|
||||
/* set a platform dependent unsigned long long value */
|
||||
/*
|
||||
int mp_set_long_long(mp_int *a, unsigned long long b);
|
||||
*/
|
||||
|
||||
/* get a 32-bit value */
|
||||
/*
|
||||
unsigned long mp_get_int(const mp_int *a);
|
||||
*/
|
||||
|
||||
/* get a platform dependent unsigned long value */
|
||||
/*
|
||||
unsigned long mp_get_long(const mp_int *a);
|
||||
*/
|
||||
|
||||
/* get a platform dependent unsigned long long value */
|
||||
/*
|
||||
unsigned long long mp_get_long_long(const mp_int *a);
|
||||
*/
|
||||
unsigned long mp_get_int(mp_int * a);
|
||||
|
||||
/* initialize and set a digit */
|
||||
/*
|
||||
int mp_init_set(mp_int *a, mp_digit b);
|
||||
int mp_init_set (mp_int * a, mp_digit b);
|
||||
*/
|
||||
|
||||
/* initialize and set 32-bit value */
|
||||
/*
|
||||
int mp_init_set_int(mp_int *a, unsigned long b);
|
||||
int mp_init_set_int (mp_int * a, unsigned long b);
|
||||
*/
|
||||
|
||||
/* copy, b = a */
|
||||
@@ -290,7 +294,7 @@ int mp_copy(const mp_int *a, mp_int *b);
|
||||
|
||||
/* inits and copies, a = b */
|
||||
/*
|
||||
int mp_init_copy(mp_int *a, const mp_int *b);
|
||||
int mp_init_copy(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* trim unused digits */
|
||||
@@ -298,16 +302,6 @@ int mp_init_copy(mp_int *a, const mp_int *b);
|
||||
void mp_clamp(mp_int *a);
|
||||
*/
|
||||
|
||||
/* import binary data */
|
||||
/*
|
||||
int mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op);
|
||||
*/
|
||||
|
||||
/* export binary data */
|
||||
/*
|
||||
int mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op);
|
||||
*/
|
||||
|
||||
/* ---> digit manipulation <--- */
|
||||
|
||||
/* right shift by "b" digits */
|
||||
@@ -320,27 +314,27 @@ void mp_rshd(mp_int *a, int b);
|
||||
int mp_lshd(mp_int *a, int b);
|
||||
*/
|
||||
|
||||
/* c = a / 2**b, implemented as c = a >> b */
|
||||
/* c = a / 2**b */
|
||||
/*
|
||||
int mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);
|
||||
*/
|
||||
|
||||
/* b = a/2 */
|
||||
/*
|
||||
int mp_div_2(const mp_int *a, mp_int *b);
|
||||
int mp_div_2(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* c = a * 2**b, implemented as c = a << b */
|
||||
/* c = a * 2**b */
|
||||
/*
|
||||
int mp_mul_2d(const mp_int *a, int b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* b = a*2 */
|
||||
/*
|
||||
int mp_mul_2(const mp_int *a, mp_int *b);
|
||||
int mp_mul_2(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* c = a mod 2**b */
|
||||
/* c = a mod 2**d */
|
||||
/*
|
||||
int mp_mod_2d(const mp_int *a, int b, mp_int *c);
|
||||
*/
|
||||
@@ -362,57 +356,24 @@ int mp_cnt_lsb(const mp_int *a);
|
||||
int mp_rand(mp_int *a, int digits);
|
||||
*/
|
||||
|
||||
#ifdef MP_PRNG_ENABLE_LTM_RNG
|
||||
/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
|
||||
* in case you don't use libtomcrypt or use it w/o rng_get_bytes()
|
||||
* you have to implement it somewhere else, as it's required */
|
||||
extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
|
||||
extern void (*ltm_rng_callback)(void);
|
||||
#endif
|
||||
|
||||
/* ---> binary operations <--- */
|
||||
/* c = a XOR b */
|
||||
/*
|
||||
int mp_xor(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_xor(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a OR b */
|
||||
/*
|
||||
int mp_or(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_or(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a AND b */
|
||||
/*
|
||||
int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a XOR b (two complement) */
|
||||
/*
|
||||
int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a OR b (two complement) */
|
||||
/*
|
||||
int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a AND b (two complement) */
|
||||
/*
|
||||
int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* right shift (two complement) */
|
||||
/*
|
||||
int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
|
||||
int mp_and(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* ---> Basic arithmetic <--- */
|
||||
|
||||
/* b = ~a */
|
||||
/*
|
||||
int mp_complement(const mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* b = -a */
|
||||
/*
|
||||
int mp_neg(const mp_int *a, mp_int *b);
|
||||
@@ -420,7 +381,7 @@ int mp_neg(const mp_int *a, mp_int *b);
|
||||
|
||||
/* b = |a| */
|
||||
/*
|
||||
int mp_abs(const mp_int *a, mp_int *b);
|
||||
int mp_abs(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* compare a to b */
|
||||
@@ -435,32 +396,32 @@ int mp_cmp_mag(const mp_int *a, const mp_int *b);
|
||||
|
||||
/* c = a + b */
|
||||
/*
|
||||
int mp_add(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_add(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a - b */
|
||||
/*
|
||||
int mp_sub(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_sub(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a * b */
|
||||
/*
|
||||
int mp_mul(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_mul(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* b = a*a */
|
||||
/*
|
||||
int mp_sqr(const mp_int *a, mp_int *b);
|
||||
int mp_sqr(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* a/b => cb + d == a */
|
||||
/*
|
||||
int mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d);
|
||||
int mp_div(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
|
||||
*/
|
||||
|
||||
/* c = a mod b, 0 <= c < b */
|
||||
/*
|
||||
int mp_mod(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_mod(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* ---> single digit functions <--- */
|
||||
@@ -472,82 +433,79 @@ int mp_cmp_d(const mp_int *a, mp_digit b);
|
||||
|
||||
/* c = a + b */
|
||||
/*
|
||||
int mp_add_d(const mp_int *a, mp_digit b, mp_int *c);
|
||||
int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a - b */
|
||||
/*
|
||||
int mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
|
||||
int mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a * b */
|
||||
/*
|
||||
int mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);
|
||||
int mp_mul_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* a/b => cb + d == a */
|
||||
/*
|
||||
int mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
|
||||
int mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
|
||||
*/
|
||||
|
||||
/* a/3 => 3c + d == a */
|
||||
/*
|
||||
int mp_div_3(const mp_int *a, mp_int *c, mp_digit *d);
|
||||
int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
|
||||
*/
|
||||
|
||||
/* c = a**b */
|
||||
/*
|
||||
int mp_expt_d(const mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
/*
|
||||
int mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast);
|
||||
int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = a mod b, 0 <= c < b */
|
||||
/*
|
||||
int mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c);
|
||||
int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
|
||||
*/
|
||||
|
||||
/* ---> number theory <--- */
|
||||
|
||||
/* d = a + b (mod c) */
|
||||
/*
|
||||
int mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
|
||||
int mp_addmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
|
||||
*/
|
||||
|
||||
/* d = a - b (mod c) */
|
||||
/*
|
||||
int mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
|
||||
int mp_submod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
|
||||
*/
|
||||
|
||||
/* d = a * b (mod c) */
|
||||
/*
|
||||
int mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);
|
||||
int mp_mulmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
|
||||
*/
|
||||
|
||||
/* c = a * a (mod b) */
|
||||
/*
|
||||
int mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_sqrmod(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = 1/a (mod b) */
|
||||
/*
|
||||
int mp_invmod(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_invmod(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* c = (a, b) */
|
||||
/*
|
||||
int mp_gcd(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_gcd(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* produces value such that U1*a + U2*b = U3 */
|
||||
/*
|
||||
int mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
|
||||
int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
|
||||
*/
|
||||
|
||||
/* c = [a, b] or (a*b)/(a, b) */
|
||||
/*
|
||||
int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* finds one of the b'th root of a, such that |c|**b <= |a|
|
||||
@@ -555,144 +513,136 @@ int mp_lcm(const mp_int *a, const mp_int *b, mp_int *c);
|
||||
* returns error if a < 0 and b is even
|
||||
*/
|
||||
/*
|
||||
int mp_n_root(const mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
/*
|
||||
int mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast);
|
||||
int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* special sqrt algo */
|
||||
/*
|
||||
int mp_sqrt(const mp_int *arg, mp_int *ret);
|
||||
*/
|
||||
|
||||
/* special sqrt (mod prime) */
|
||||
/*
|
||||
int mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret);
|
||||
int mp_sqrt(mp_int *arg, mp_int *ret);
|
||||
*/
|
||||
|
||||
/* is number a square? */
|
||||
/*
|
||||
int mp_is_square(const mp_int *arg, int *ret);
|
||||
int mp_is_square(mp_int *arg, int *ret);
|
||||
*/
|
||||
|
||||
/* computes the jacobi c = (a | n) (or Legendre if b is prime) */
|
||||
/*
|
||||
int mp_jacobi(const mp_int *a, const mp_int *n, int *c);
|
||||
int mp_jacobi(mp_int *a, mp_int *n, int *c);
|
||||
*/
|
||||
|
||||
/* used to setup the Barrett reduction for a given modulus b */
|
||||
/*
|
||||
int mp_reduce_setup(mp_int *a, const mp_int *b);
|
||||
int mp_reduce_setup(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* Barrett Reduction, computes a (mod b) with a precomputed value c
|
||||
*
|
||||
* Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely
|
||||
* compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code].
|
||||
* Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
|
||||
* compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
|
||||
*/
|
||||
/*
|
||||
int mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu);
|
||||
int mp_reduce(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
|
||||
/* setups the montgomery reduction */
|
||||
/*
|
||||
int mp_montgomery_setup(const mp_int *n, mp_digit *rho);
|
||||
int mp_montgomery_setup(mp_int *a, mp_digit *mp);
|
||||
*/
|
||||
|
||||
/* computes a = B**n mod b without division or multiplication useful for
|
||||
* normalizing numbers in a Montgomery system.
|
||||
*/
|
||||
/*
|
||||
int mp_montgomery_calc_normalization(mp_int *a, const mp_int *b);
|
||||
int mp_montgomery_calc_normalization(mp_int *a, mp_int *b);
|
||||
*/
|
||||
|
||||
/* computes x/R == x (mod N) via Montgomery Reduction */
|
||||
/*
|
||||
int mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho);
|
||||
int mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
|
||||
*/
|
||||
|
||||
/* returns 1 if a is a valid DR modulus */
|
||||
/*
|
||||
int mp_dr_is_modulus(const mp_int *a);
|
||||
int mp_dr_is_modulus(mp_int *a);
|
||||
*/
|
||||
|
||||
/* sets the value of "d" required for mp_dr_reduce */
|
||||
/*
|
||||
void mp_dr_setup(const mp_int *a, mp_digit *d);
|
||||
void mp_dr_setup(mp_int *a, mp_digit *d);
|
||||
*/
|
||||
|
||||
/* reduces a modulo n using the Diminished Radix method */
|
||||
/* reduces a modulo b using the Diminished Radix method */
|
||||
/*
|
||||
int mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k);
|
||||
int mp_dr_reduce(mp_int *a, mp_int *b, mp_digit mp);
|
||||
*/
|
||||
|
||||
/* returns true if a can be reduced with mp_reduce_2k */
|
||||
/*
|
||||
int mp_reduce_is_2k(const mp_int *a);
|
||||
int mp_reduce_is_2k(mp_int *a);
|
||||
*/
|
||||
|
||||
/* determines k value for 2k reduction */
|
||||
/*
|
||||
int mp_reduce_2k_setup(const mp_int *a, mp_digit *d);
|
||||
int mp_reduce_2k_setup(mp_int *a, mp_digit *d);
|
||||
*/
|
||||
|
||||
/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
|
||||
/*
|
||||
int mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d);
|
||||
int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d);
|
||||
*/
|
||||
|
||||
/* returns true if a can be reduced with mp_reduce_2k_l */
|
||||
/*
|
||||
int mp_reduce_is_2k_l(const mp_int *a);
|
||||
int mp_reduce_is_2k_l(mp_int *a);
|
||||
*/
|
||||
|
||||
/* determines k value for 2k reduction */
|
||||
/*
|
||||
int mp_reduce_2k_setup_l(const mp_int *a, mp_int *d);
|
||||
int mp_reduce_2k_setup_l(mp_int *a, mp_int *d);
|
||||
*/
|
||||
|
||||
/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
|
||||
/*
|
||||
int mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d);
|
||||
int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d);
|
||||
*/
|
||||
|
||||
/* Y = G**X (mod P) */
|
||||
/* d = a**b (mod c) */
|
||||
/*
|
||||
int mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y);
|
||||
int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
|
||||
*/
|
||||
|
||||
/* ---> Primes <--- */
|
||||
|
||||
/* number of primes */
|
||||
#ifdef MP_8BIT
|
||||
# define PRIME_SIZE 31
|
||||
# define PRIME_SIZE 31
|
||||
#else
|
||||
# define PRIME_SIZE 256
|
||||
# define PRIME_SIZE 256
|
||||
#endif
|
||||
|
||||
/* table of first PRIME_SIZE primes */
|
||||
#if defined(BUILD_tcl) || !defined(_WIN32)
|
||||
MODULE_SCOPE const mp_digit ltm_prime_tab[PRIME_SIZE];
|
||||
MODULE_SCOPE const mp_digit ltm_prime_tab[];
|
||||
#endif
|
||||
|
||||
/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
|
||||
/*
|
||||
int mp_prime_is_divisible(const mp_int *a, int *result);
|
||||
int mp_prime_is_divisible(mp_int *a, int *result);
|
||||
*/
|
||||
|
||||
/* performs one Fermat test of "a" using base "b".
|
||||
* Sets result to 0 if composite or 1 if probable prime
|
||||
*/
|
||||
/*
|
||||
int mp_prime_fermat(const mp_int *a, const mp_int *b, int *result);
|
||||
int mp_prime_fermat(mp_int *a, mp_int *b, int *result);
|
||||
*/
|
||||
|
||||
/* performs one Miller-Rabin test of "a" using base "b".
|
||||
* Sets result to 0 if composite or 1 if probable prime
|
||||
*/
|
||||
/*
|
||||
int mp_prime_miller_rabin(const mp_int *a, const mp_int *b, int *result);
|
||||
int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
|
||||
*/
|
||||
|
||||
/* This gives [for a given bit size] the number of trials required
|
||||
@@ -710,7 +660,7 @@ int mp_prime_rabin_miller_trials(int size);
|
||||
* Sets result to 1 if probably prime, 0 otherwise
|
||||
*/
|
||||
/*
|
||||
int mp_prime_is_prime(const mp_int *a, int t, int *result);
|
||||
int mp_prime_is_prime(mp_int *a, int t, int *result);
|
||||
*/
|
||||
|
||||
/* finds the next prime after the number "a" using "t" trials
|
||||
@@ -739,6 +689,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
|
||||
*
|
||||
* LTM_PRIME_BBS - make prime congruent to 3 mod 4
|
||||
* LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
|
||||
* LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
|
||||
* LTM_PRIME_2MSB_ON - make the 2nd highest bit one
|
||||
*
|
||||
* You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
|
||||
@@ -756,52 +707,50 @@ int mp_count_bits(const mp_int *a);
|
||||
*/
|
||||
|
||||
/*
|
||||
int mp_unsigned_bin_size(const mp_int *a);
|
||||
int mp_unsigned_bin_size(mp_int *a);
|
||||
*/
|
||||
/*
|
||||
int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
|
||||
*/
|
||||
/*
|
||||
int mp_to_unsigned_bin(const mp_int *a, unsigned char *b);
|
||||
int mp_to_unsigned_bin(mp_int *a, unsigned char *b);
|
||||
*/
|
||||
/*
|
||||
int mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen);
|
||||
int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
|
||||
*/
|
||||
|
||||
/*
|
||||
int mp_signed_bin_size(const mp_int *a);
|
||||
int mp_signed_bin_size(mp_int *a);
|
||||
*/
|
||||
/*
|
||||
int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
|
||||
*/
|
||||
/*
|
||||
int mp_to_signed_bin(const mp_int *a, unsigned char *b);
|
||||
int mp_to_signed_bin(mp_int *a, unsigned char *b);
|
||||
*/
|
||||
/*
|
||||
int mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen);
|
||||
int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
|
||||
*/
|
||||
|
||||
/*
|
||||
int mp_read_radix(mp_int *a, const char *str, int radix);
|
||||
*/
|
||||
/*
|
||||
int mp_toradix(const mp_int *a, char *str, int radix);
|
||||
int mp_toradix(mp_int *a, char *str, int radix);
|
||||
*/
|
||||
/*
|
||||
int mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen);
|
||||
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
|
||||
*/
|
||||
/*
|
||||
int mp_radix_size(const mp_int *a, int radix, int *size);
|
||||
int mp_radix_size(mp_int *a, int radix, int *size);
|
||||
*/
|
||||
|
||||
#ifndef LTM_NO_FILE
|
||||
/*
|
||||
int mp_fread(mp_int *a, int radix, FILE *stream);
|
||||
*/
|
||||
/*
|
||||
int mp_fwrite(const mp_int *a, int radix, FILE *stream);
|
||||
int mp_fwrite(mp_int *a, int radix, FILE *stream);
|
||||
*/
|
||||
#endif
|
||||
|
||||
#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
|
||||
#define mp_raw_size(mp) mp_signed_bin_size(mp)
|
||||
@@ -815,14 +764,69 @@ int mp_fwrite(const mp_int *a, int radix, FILE *stream);
|
||||
#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
|
||||
#define mp_tohex(M, S) mp_toradix((M), (S), 16)
|
||||
|
||||
/* lowlevel functions, do not call! */
|
||||
/*
|
||||
int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
/*
|
||||
int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
|
||||
/*
|
||||
int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
|
||||
*/
|
||||
/*
|
||||
int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
|
||||
*/
|
||||
/*
|
||||
int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
|
||||
*/
|
||||
/*
|
||||
int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
|
||||
*/
|
||||
/*
|
||||
int fast_s_mp_sqr(mp_int *a, mp_int *b);
|
||||
*/
|
||||
/*
|
||||
int s_mp_sqr(mp_int *a, mp_int *b);
|
||||
*/
|
||||
/*
|
||||
int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
/*
|
||||
int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
/*
|
||||
int mp_karatsuba_sqr(mp_int *a, mp_int *b);
|
||||
*/
|
||||
/*
|
||||
int mp_toom_sqr(mp_int *a, mp_int *b);
|
||||
*/
|
||||
/*
|
||||
int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
|
||||
*/
|
||||
/*
|
||||
int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
|
||||
*/
|
||||
/*
|
||||
int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
|
||||
*/
|
||||
/*
|
||||
int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
|
||||
*/
|
||||
/*
|
||||
int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
|
||||
*/
|
||||
/*
|
||||
void bn_reverse(unsigned char *s, int len);
|
||||
*/
|
||||
|
||||
#if defined(BUILD_tcl) || !defined(_WIN32)
|
||||
MODULE_SCOPE const char *mp_s_rmap;
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
/* ref: $Format:%D$ */
|
||||
/* git commit: $Format:%H$ */
|
||||
/* commit time: $Format:%ai$ */
|
||||
|
||||
|
||||
+82
-105
@@ -73,7 +73,6 @@
|
||||
#define mp_div_d TclBN_mp_div_d
|
||||
#define mp_exch TclBN_mp_exch
|
||||
#define mp_expt_d TclBN_mp_expt_d
|
||||
#define mp_expt_d_ex TclBN_mp_expt_d_ex
|
||||
#define mp_grow TclBN_mp_grow
|
||||
#define mp_init TclBN_mp_init
|
||||
#define mp_init_copy TclBN_mp_init_copy
|
||||
@@ -95,6 +94,7 @@
|
||||
#define mp_radix_size TclBN_mp_radix_size
|
||||
#define mp_read_radix TclBN_mp_read_radix
|
||||
#define mp_rshd TclBN_mp_rshd
|
||||
#define mp_s_rmap TclBNMpSRmap
|
||||
#define mp_set TclBN_mp_set
|
||||
#define mp_set_int TclBN_mp_set_int
|
||||
#define mp_shrink TclBN_mp_shrink
|
||||
@@ -147,14 +147,11 @@ EXTERN int TclBN_epoch(void);
|
||||
/* 1 */
|
||||
EXTERN int TclBN_revision(void);
|
||||
/* 2 */
|
||||
EXTERN int TclBN_mp_add(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 3 */
|
||||
EXTERN int TclBN_mp_add_d(const mp_int *a, mp_digit b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
/* 4 */
|
||||
EXTERN int TclBN_mp_and(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 5 */
|
||||
EXTERN void TclBN_mp_clamp(mp_int *a);
|
||||
/* 6 */
|
||||
@@ -172,30 +169,28 @@ EXTERN int TclBN_mp_copy(const mp_int *a, mp_int *b);
|
||||
/* 12 */
|
||||
EXTERN int TclBN_mp_count_bits(const mp_int *a);
|
||||
/* 13 */
|
||||
EXTERN int TclBN_mp_div(const mp_int *a, const mp_int *b,
|
||||
mp_int *q, mp_int *r);
|
||||
EXTERN int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
|
||||
mp_int *r);
|
||||
/* 14 */
|
||||
EXTERN int TclBN_mp_div_d(const mp_int *a, mp_digit b,
|
||||
mp_int *q, mp_digit *r);
|
||||
EXTERN int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
|
||||
mp_digit *r);
|
||||
/* 15 */
|
||||
EXTERN int TclBN_mp_div_2(const mp_int *a, mp_int *q);
|
||||
EXTERN int TclBN_mp_div_2(mp_int *a, mp_int *q);
|
||||
/* 16 */
|
||||
EXTERN int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
|
||||
mp_int *r);
|
||||
/* 17 */
|
||||
EXTERN int TclBN_mp_div_3(const mp_int *a, mp_int *q,
|
||||
mp_digit *r);
|
||||
EXTERN int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
|
||||
/* 18 */
|
||||
EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b);
|
||||
/* 19 */
|
||||
EXTERN int TclBN_mp_expt_d(const mp_int *a, mp_digit b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
/* 20 */
|
||||
EXTERN int TclBN_mp_grow(mp_int *a, int size);
|
||||
/* 21 */
|
||||
EXTERN int TclBN_mp_init(mp_int *a);
|
||||
/* 22 */
|
||||
EXTERN int TclBN_mp_init_copy(mp_int *a, const mp_int *b);
|
||||
EXTERN int TclBN_mp_init_copy(mp_int *a, mp_int *b);
|
||||
/* 23 */
|
||||
EXTERN int TclBN_mp_init_multi(mp_int *a, ...);
|
||||
/* 24 */
|
||||
@@ -205,28 +200,23 @@ EXTERN int TclBN_mp_init_size(mp_int *a, int size);
|
||||
/* 26 */
|
||||
EXTERN int TclBN_mp_lshd(mp_int *a, int shift);
|
||||
/* 27 */
|
||||
EXTERN int TclBN_mp_mod(const mp_int *a, const mp_int *b,
|
||||
mp_int *r);
|
||||
EXTERN int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
|
||||
/* 28 */
|
||||
EXTERN int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r);
|
||||
/* 29 */
|
||||
EXTERN int TclBN_mp_mul(const mp_int *a, const mp_int *b,
|
||||
mp_int *p);
|
||||
EXTERN int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
|
||||
/* 30 */
|
||||
EXTERN int TclBN_mp_mul_d(const mp_int *a, mp_digit b,
|
||||
mp_int *p);
|
||||
EXTERN int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
|
||||
/* 31 */
|
||||
EXTERN int TclBN_mp_mul_2(const mp_int *a, mp_int *p);
|
||||
EXTERN int TclBN_mp_mul_2(mp_int *a, mp_int *p);
|
||||
/* 32 */
|
||||
EXTERN int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p);
|
||||
/* 33 */
|
||||
EXTERN int TclBN_mp_neg(const mp_int *a, mp_int *b);
|
||||
/* 34 */
|
||||
EXTERN int TclBN_mp_or(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 35 */
|
||||
EXTERN int TclBN_mp_radix_size(const mp_int *a, int radix,
|
||||
int *size);
|
||||
EXTERN int TclBN_mp_radix_size(mp_int *a, int radix, int *size);
|
||||
/* 36 */
|
||||
EXTERN int TclBN_mp_read_radix(mp_int *a, const char *str,
|
||||
int radix);
|
||||
@@ -237,59 +227,52 @@ EXTERN int TclBN_mp_shrink(mp_int *a);
|
||||
/* 39 */
|
||||
EXTERN void TclBN_mp_set(mp_int *a, mp_digit b);
|
||||
/* 40 */
|
||||
EXTERN int TclBN_mp_sqr(const mp_int *a, mp_int *b);
|
||||
EXTERN int TclBN_mp_sqr(mp_int *a, mp_int *b);
|
||||
/* 41 */
|
||||
EXTERN int TclBN_mp_sqrt(const mp_int *a, mp_int *b);
|
||||
EXTERN int TclBN_mp_sqrt(mp_int *a, mp_int *b);
|
||||
/* 42 */
|
||||
EXTERN int TclBN_mp_sub(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 43 */
|
||||
EXTERN int TclBN_mp_sub_d(const mp_int *a, mp_digit b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
|
||||
/* 44 */
|
||||
EXTERN int TclBN_mp_to_unsigned_bin(const mp_int *a,
|
||||
unsigned char *b);
|
||||
EXTERN int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
|
||||
/* 45 */
|
||||
EXTERN int TclBN_mp_to_unsigned_bin_n(const mp_int *a,
|
||||
EXTERN int TclBN_mp_to_unsigned_bin_n(mp_int *a,
|
||||
unsigned char *b, unsigned long *outlen);
|
||||
/* 46 */
|
||||
EXTERN int TclBN_mp_toradix_n(const mp_int *a, char *str,
|
||||
int radix, int maxlen);
|
||||
EXTERN int TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
|
||||
int maxlen);
|
||||
/* 47 */
|
||||
EXTERN int TclBN_mp_unsigned_bin_size(const mp_int *a);
|
||||
EXTERN int TclBN_mp_unsigned_bin_size(mp_int *a);
|
||||
/* 48 */
|
||||
EXTERN int TclBN_mp_xor(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
EXTERN int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 49 */
|
||||
EXTERN void TclBN_mp_zero(mp_int *a);
|
||||
/* 50 */
|
||||
EXTERN void TclBN_reverse(unsigned char *s, int len);
|
||||
/* 51 */
|
||||
EXTERN int TclBN_fast_s_mp_mul_digs(const mp_int *a,
|
||||
const mp_int *b, mp_int *c, int digs);
|
||||
/* 52 */
|
||||
EXTERN int TclBN_fast_s_mp_sqr(const mp_int *a, mp_int *b);
|
||||
/* 53 */
|
||||
EXTERN int TclBN_mp_karatsuba_mul(const mp_int *a,
|
||||
const mp_int *b, mp_int *c);
|
||||
/* 54 */
|
||||
EXTERN int TclBN_mp_karatsuba_sqr(const mp_int *a, mp_int *b);
|
||||
/* 55 */
|
||||
EXTERN int TclBN_mp_toom_mul(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
/* 56 */
|
||||
EXTERN int TclBN_mp_toom_sqr(const mp_int *a, mp_int *b);
|
||||
/* 57 */
|
||||
EXTERN int TclBN_s_mp_add(const mp_int *a, const mp_int *b,
|
||||
mp_int *c);
|
||||
/* 58 */
|
||||
EXTERN int TclBN_s_mp_mul_digs(const mp_int *a, const mp_int *b,
|
||||
EXTERN int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
|
||||
mp_int *c, int digs);
|
||||
/* 59 */
|
||||
EXTERN int TclBN_s_mp_sqr(const mp_int *a, mp_int *b);
|
||||
/* 60 */
|
||||
EXTERN int TclBN_s_mp_sub(const mp_int *a, const mp_int *b,
|
||||
/* 52 */
|
||||
EXTERN int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
|
||||
/* 53 */
|
||||
EXTERN int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
|
||||
mp_int *c);
|
||||
/* 54 */
|
||||
EXTERN int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
|
||||
/* 55 */
|
||||
EXTERN int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 56 */
|
||||
EXTERN int TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
|
||||
/* 57 */
|
||||
EXTERN int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 58 */
|
||||
EXTERN int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
|
||||
int digs);
|
||||
/* 59 */
|
||||
EXTERN int TclBN_s_mp_sqr(mp_int *a, mp_int *b);
|
||||
/* 60 */
|
||||
EXTERN int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
|
||||
/* 61 */
|
||||
EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i);
|
||||
/* 62 */
|
||||
@@ -304,9 +287,6 @@ EXTERN void TclBNInitBignumFromWideInt(mp_int *bignum,
|
||||
/* 66 */
|
||||
EXTERN void TclBNInitBignumFromWideUInt(mp_int *bignum,
|
||||
Tcl_WideUInt initVal);
|
||||
/* 67 */
|
||||
EXTERN int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b,
|
||||
mp_int *c, int fast);
|
||||
|
||||
typedef struct TclTomMathStubs {
|
||||
int magic;
|
||||
@@ -314,9 +294,9 @@ typedef struct TclTomMathStubs {
|
||||
|
||||
int (*tclBN_epoch) (void); /* 0 */
|
||||
int (*tclBN_revision) (void); /* 1 */
|
||||
int (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 2 */
|
||||
int (*tclBN_mp_add_d) (const mp_int *a, mp_digit b, mp_int *c); /* 3 */
|
||||
int (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 4 */
|
||||
int (*tclBN_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 2 */
|
||||
int (*tclBN_mp_add_d) (mp_int *a, mp_digit b, mp_int *c); /* 3 */
|
||||
int (*tclBN_mp_and) (mp_int *a, mp_int *b, mp_int *c); /* 4 */
|
||||
void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
|
||||
void (*tclBN_mp_clear) (mp_int *a); /* 6 */
|
||||
void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
|
||||
@@ -325,61 +305,60 @@ typedef struct TclTomMathStubs {
|
||||
int (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b); /* 10 */
|
||||
int (*tclBN_mp_copy) (const mp_int *a, mp_int *b); /* 11 */
|
||||
int (*tclBN_mp_count_bits) (const mp_int *a); /* 12 */
|
||||
int (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r); /* 13 */
|
||||
int (*tclBN_mp_div_d) (const mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
|
||||
int (*tclBN_mp_div_2) (const mp_int *a, mp_int *q); /* 15 */
|
||||
int (*tclBN_mp_div) (mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 13 */
|
||||
int (*tclBN_mp_div_d) (mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
|
||||
int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
|
||||
int (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
|
||||
int (*tclBN_mp_div_3) (const mp_int *a, mp_int *q, mp_digit *r); /* 17 */
|
||||
int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
|
||||
void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
|
||||
int (*tclBN_mp_expt_d) (const mp_int *a, mp_digit b, mp_int *c); /* 19 */
|
||||
int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
|
||||
int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
|
||||
int (*tclBN_mp_init) (mp_int *a); /* 21 */
|
||||
int (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b); /* 22 */
|
||||
int (*tclBN_mp_init_copy) (mp_int *a, mp_int *b); /* 22 */
|
||||
int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
|
||||
int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
|
||||
int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
|
||||
int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
|
||||
int (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r); /* 27 */
|
||||
int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
|
||||
int (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r); /* 28 */
|
||||
int (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p); /* 29 */
|
||||
int (*tclBN_mp_mul_d) (const mp_int *a, mp_digit b, mp_int *p); /* 30 */
|
||||
int (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p); /* 31 */
|
||||
int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
|
||||
int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
|
||||
int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
|
||||
int (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p); /* 32 */
|
||||
int (*tclBN_mp_neg) (const mp_int *a, mp_int *b); /* 33 */
|
||||
int (*tclBN_mp_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 34 */
|
||||
int (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size); /* 35 */
|
||||
int (*tclBN_mp_or) (mp_int *a, mp_int *b, mp_int *c); /* 34 */
|
||||
int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
|
||||
int (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix); /* 36 */
|
||||
void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
|
||||
int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
|
||||
void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
|
||||
int (*tclBN_mp_sqr) (const mp_int *a, mp_int *b); /* 40 */
|
||||
int (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b); /* 41 */
|
||||
int (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 42 */
|
||||
int (*tclBN_mp_sub_d) (const mp_int *a, mp_digit b, mp_int *c); /* 43 */
|
||||
int (*tclBN_mp_to_unsigned_bin) (const mp_int *a, unsigned char *b); /* 44 */
|
||||
int (*tclBN_mp_to_unsigned_bin_n) (const mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
|
||||
int (*tclBN_mp_toradix_n) (const mp_int *a, char *str, int radix, int maxlen); /* 46 */
|
||||
int (*tclBN_mp_unsigned_bin_size) (const mp_int *a); /* 47 */
|
||||
int (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 48 */
|
||||
int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
|
||||
int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
|
||||
int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
|
||||
int (*tclBN_mp_sub_d) (mp_int *a, mp_digit b, mp_int *c); /* 43 */
|
||||
int (*tclBN_mp_to_unsigned_bin) (mp_int *a, unsigned char *b); /* 44 */
|
||||
int (*tclBN_mp_to_unsigned_bin_n) (mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
|
||||
int (*tclBN_mp_toradix_n) (mp_int *a, char *str, int radix, int maxlen); /* 46 */
|
||||
int (*tclBN_mp_unsigned_bin_size) (mp_int *a); /* 47 */
|
||||
int (*tclBN_mp_xor) (mp_int *a, mp_int *b, mp_int *c); /* 48 */
|
||||
void (*tclBN_mp_zero) (mp_int *a); /* 49 */
|
||||
void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
|
||||
int (*tclBN_fast_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 51 */
|
||||
int (*tclBN_fast_s_mp_sqr) (const mp_int *a, mp_int *b); /* 52 */
|
||||
int (*tclBN_mp_karatsuba_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 53 */
|
||||
int (*tclBN_mp_karatsuba_sqr) (const mp_int *a, mp_int *b); /* 54 */
|
||||
int (*tclBN_mp_toom_mul) (const mp_int *a, const mp_int *b, mp_int *c); /* 55 */
|
||||
int (*tclBN_mp_toom_sqr) (const mp_int *a, mp_int *b); /* 56 */
|
||||
int (*tclBN_s_mp_add) (const mp_int *a, const mp_int *b, mp_int *c); /* 57 */
|
||||
int (*tclBN_s_mp_mul_digs) (const mp_int *a, const mp_int *b, mp_int *c, int digs); /* 58 */
|
||||
int (*tclBN_s_mp_sqr) (const mp_int *a, mp_int *b); /* 59 */
|
||||
int (*tclBN_s_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c); /* 60 */
|
||||
int (*tclBN_fast_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 51 */
|
||||
int (*tclBN_fast_s_mp_sqr) (mp_int *a, mp_int *b); /* 52 */
|
||||
int (*tclBN_mp_karatsuba_mul) (mp_int *a, mp_int *b, mp_int *c); /* 53 */
|
||||
int (*tclBN_mp_karatsuba_sqr) (mp_int *a, mp_int *b); /* 54 */
|
||||
int (*tclBN_mp_toom_mul) (mp_int *a, mp_int *b, mp_int *c); /* 55 */
|
||||
int (*tclBN_mp_toom_sqr) (mp_int *a, mp_int *b); /* 56 */
|
||||
int (*tclBN_s_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 57 */
|
||||
int (*tclBN_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 58 */
|
||||
int (*tclBN_s_mp_sqr) (mp_int *a, mp_int *b); /* 59 */
|
||||
int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
|
||||
int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
|
||||
int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
|
||||
int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
|
||||
void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
|
||||
void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
|
||||
void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
|
||||
int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
|
||||
} TclTomMathStubs;
|
||||
|
||||
extern const TclTomMathStubs *tclTomMathStubsPtr;
|
||||
@@ -528,8 +507,6 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
|
||||
(tclTomMathStubsPtr->tclBNInitBignumFromWideInt) /* 65 */
|
||||
#define TclBNInitBignumFromWideUInt \
|
||||
(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
|
||||
#define TclBN_mp_expt_d_ex \
|
||||
(tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */
|
||||
|
||||
#endif /* defined(USE_TCL_STUBS) */
|
||||
|
||||
|
||||
+13
-56
@@ -191,10 +191,8 @@ Tcl_TraceObjCmd(
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
int optionIndex;
|
||||
#ifndef TCL_REMOVE_OBSOLETE_TRACES
|
||||
const char *name;
|
||||
const char *flagOps, *p;
|
||||
#endif
|
||||
/* Main sub commands to 'trace' */
|
||||
static const char *const traceOptions[] = {
|
||||
"add", "info", "remove",
|
||||
@@ -367,14 +365,12 @@ Tcl_TraceObjCmd(
|
||||
}
|
||||
return TCL_OK;
|
||||
|
||||
#ifndef TCL_REMOVE_OBSOLETE_TRACES
|
||||
badVarOps:
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad operations \"%s\": should be one or more of rwua",
|
||||
flagOps));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
|
||||
return TCL_ERROR;
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -537,7 +533,9 @@ TraceExecutionObjCmd(
|
||||
|
||||
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
|
||||
tcmdPtr->stepTrace = NULL;
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
if (tcmdPtr->startCmd != NULL) {
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
}
|
||||
}
|
||||
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
|
||||
/*
|
||||
@@ -914,11 +912,9 @@ TraceVariableObjCmd(
|
||||
+ 1 + length);
|
||||
|
||||
ctvarPtr->traceCmdInfo.flags = flags;
|
||||
#ifndef TCL_REMOVE_OBSOLETE_TRACES
|
||||
if (objv[0] == NULL) {
|
||||
ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
|
||||
}
|
||||
#endif
|
||||
ctvarPtr->traceCmdInfo.length = length;
|
||||
flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
|
||||
memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
|
||||
@@ -943,11 +939,7 @@ TraceVariableObjCmd(
|
||||
TraceVarInfo *tvarPtr = clientData;
|
||||
|
||||
if ((tvarPtr->length == length)
|
||||
&& ((tvarPtr->flags
|
||||
#ifndef TCL_REMOVE_OBSOLETE_TRACES
|
||||
& ~TCL_TRACE_OLD_STYLE
|
||||
#endif
|
||||
)==flags)
|
||||
&& ((tvarPtr->flags & ~TCL_TRACE_OLD_STYLE)==flags)
|
||||
&& (strncmp(command, tvarPtr->command,
|
||||
(size_t) length) == 0)) {
|
||||
Tcl_UntraceVar2(interp, name, NULL,
|
||||
@@ -1347,7 +1339,9 @@ TraceCommandProc(
|
||||
if (tcmdPtr->stepTrace != NULL) {
|
||||
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
|
||||
tcmdPtr->stepTrace = NULL;
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
if (tcmdPtr->startCmd != NULL) {
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
}
|
||||
}
|
||||
if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
|
||||
/*
|
||||
@@ -1810,7 +1804,9 @@ TraceExecutionProc(
|
||||
&& (strcmp(command, tcmdPtr->startCmd) == 0)) {
|
||||
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
|
||||
tcmdPtr->stepTrace = NULL;
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
if (tcmdPtr->startCmd != NULL) {
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1935,7 +1931,9 @@ TraceExecutionProc(
|
||||
if (tcmdPtr->stepTrace != NULL) {
|
||||
Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
|
||||
tcmdPtr->stepTrace = NULL;
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
if (tcmdPtr->startCmd != NULL) {
|
||||
ckfree(tcmdPtr->startCmd);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (call) {
|
||||
@@ -2467,47 +2465,6 @@ TclVarTraceExists(
|
||||
return varPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCheckArrayTraces --
|
||||
*
|
||||
* This function is invoked to when we operate on an array variable,
|
||||
* to allow any array traces to fire.
|
||||
*
|
||||
* Results:
|
||||
* Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if
|
||||
* invocation of a trace function indicated an error. When TCL_ERROR is
|
||||
* returned, then error information is left in interp.
|
||||
*
|
||||
* Side effects:
|
||||
* Almost anything can happen, depending on trace; this function itself
|
||||
* doesn't have any side effects.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCheckArrayTraces(
|
||||
Tcl_Interp *interp,
|
||||
Var *varPtr,
|
||||
Var *arrayPtr,
|
||||
Tcl_Obj *name,
|
||||
int index)
|
||||
{
|
||||
int code = TCL_OK;
|
||||
|
||||
if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
|
||||
&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
|
||||
Interp *iPtr = (Interp *)interp;
|
||||
|
||||
code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL,
|
||||
(TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY),
|
||||
/* leaveErrMsg */ 1, index);
|
||||
}
|
||||
return code;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+1081
-1128
File diff suppressed because it is too large
Load Diff
+84
-175
@@ -100,7 +100,7 @@ static int UtfCount(int ch);
|
||||
|
||||
static inline int
|
||||
UtfCount(
|
||||
int ch) /* The Unicode character whose size is returned. */
|
||||
int ch) /* The Tcl_UniChar whose size is returned. */
|
||||
{
|
||||
if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
|
||||
return 1;
|
||||
@@ -154,26 +154,20 @@ Tcl_UniCharToUtf(
|
||||
return 2;
|
||||
}
|
||||
if (ch <= 0xFFFF) {
|
||||
#if TCL_UTF_MAX > 3
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((ch & 0xF800) == 0xD800) {
|
||||
if (ch & 0x0400) {
|
||||
/* Low surrogate */
|
||||
if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)) {
|
||||
/* Previous Tcl_UniChar was a high surrogate, so combine */
|
||||
buf[2] = (char) ((ch & 0x3F) | 0x80);
|
||||
buf[1] |= (char) (((ch >> 6) & 0x0F) | 0x80);
|
||||
return 3;
|
||||
}
|
||||
/* Previous Tcl_UniChar was not a high surrogate, so just output */
|
||||
buf[3] = (char) ((ch | 0x80) & 0xBF);
|
||||
buf[2] |= (char) (((ch >> 6) | 0x80) & 0x8F);
|
||||
return 4;
|
||||
} else {
|
||||
/* High surrogate */
|
||||
ch += 0x40;
|
||||
/* Fill buffer with specific 3-byte (invalid) byte combination,
|
||||
so following low surrogate can recognize it and combine */
|
||||
buf[2] = (char) ((ch << 4) & 0x30);
|
||||
buf[1] = (char) (((ch >> 2) & 0x3F) | 0x80);
|
||||
buf[0] = (char) (((ch >> 8) & 0x07) | 0xF0);
|
||||
return 1;
|
||||
buf[2] = (char) (((ch << 4) | 0x80) & 0xB0);
|
||||
buf[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
|
||||
buf[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
@@ -188,16 +182,6 @@ Tcl_UniCharToUtf(
|
||||
buf[0] = (char) ((ch >> 18) | 0xF0);
|
||||
return 4;
|
||||
}
|
||||
} else if (ch == -1) {
|
||||
if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)
|
||||
&& ((buf[-1] & 0xF8) == 0xF0)) {
|
||||
ch = 0xD7C0 + ((buf[-1] & 0x07) << 8) + ((buf[0] & 0x3F) << 2)
|
||||
+ ((buf[1] & 0x30) >> 4);
|
||||
buf[1] = (char) ((ch | 0x80) & 0xBF);
|
||||
buf[0] = (char) (((ch >> 6) | 0x80) & 0xBF);
|
||||
buf[-1] = (char) ((ch >> 12) | 0xE0);
|
||||
return 2;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -245,7 +229,7 @@ Tcl_UniCharToUtfDString(
|
||||
*/
|
||||
|
||||
oldLength = Tcl_DStringLength(dsPtr);
|
||||
Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX);
|
||||
Tcl_DStringSetLength(dsPtr, (oldLength + uniLength + 1) * TCL_UTF_MAX);
|
||||
string = Tcl_DStringValue(dsPtr) + oldLength;
|
||||
|
||||
p = string;
|
||||
@@ -300,7 +284,7 @@ Tcl_UtfToUniChar(
|
||||
register Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by
|
||||
* the UTF-8 string. */
|
||||
{
|
||||
Tcl_UniChar byte;
|
||||
register int byte;
|
||||
|
||||
/*
|
||||
* Unroll 1 to 3 (or 4) byte UTF-8 sequences.
|
||||
@@ -314,21 +298,7 @@ Tcl_UtfToUniChar(
|
||||
* characters representing themselves.
|
||||
*/
|
||||
|
||||
#if TCL_UTF_MAX == 4
|
||||
/* If *chPtr contains a high surrogate (produced by a previous
|
||||
* Tcl_UtfToUniChar() call) and the next 3 bytes are UTF-8 continuation
|
||||
* bytes, then we must produce a follow-up low surrogate. We only
|
||||
* do that if the high surrogate matches the bits we encounter.
|
||||
*/
|
||||
if ((byte >= 0x80)
|
||||
&& (((((byte - 0x10) << 2) & 0xFC) | 0xD800) == (*chPtr & 0xFCFC))
|
||||
&& ((src[1] & 0xF0) == (((*chPtr << 4) & 0x30) | 0x80))
|
||||
&& ((src[2] & 0xC0) == 0x80)) {
|
||||
*chPtr = ((src[1] & 0x0F) << 6) + (src[2] & 0x3F) + 0xDC00;
|
||||
return 3;
|
||||
}
|
||||
#endif
|
||||
*chPtr = byte;
|
||||
*chPtr = (Tcl_UniChar) byte;
|
||||
return 1;
|
||||
} else if (byte < 0xE0) {
|
||||
if ((src[1] & 0xC0) == 0x80) {
|
||||
@@ -336,7 +306,7 @@ Tcl_UtfToUniChar(
|
||||
* Two-byte-character lead-byte followed by a trail-byte.
|
||||
*/
|
||||
|
||||
*chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F));
|
||||
*chPtr = (Tcl_UniChar) (((byte & 0x1F) << 6) | (src[1] & 0x3F));
|
||||
if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
|
||||
return 2;
|
||||
}
|
||||
@@ -352,7 +322,7 @@ Tcl_UtfToUniChar(
|
||||
* Three-byte-character lead byte followed by two trail bytes.
|
||||
*/
|
||||
|
||||
*chPtr = (((byte & 0x0F) << 12)
|
||||
*chPtr = (Tcl_UniChar) (((byte & 0x0F) << 12)
|
||||
| ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
|
||||
if (*chPtr > 0x7FF) {
|
||||
return 3;
|
||||
@@ -371,19 +341,26 @@ Tcl_UtfToUniChar(
|
||||
* Four-byte-character lead byte followed by three trail bytes.
|
||||
*/
|
||||
#if TCL_UTF_MAX == 4
|
||||
Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2)
|
||||
| ((src[2] & 0x3F) >> 4)) - 0x40;
|
||||
if (high >= 0x400) {
|
||||
Tcl_UniChar surrogate;
|
||||
|
||||
byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
|
||||
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)) - 0x10000;
|
||||
surrogate = (Tcl_UniChar) (0xD800 + (byte >> 10));
|
||||
if (byte & 0x100000) {
|
||||
/* out of range, < 0x10000 or > 0x10ffff */
|
||||
} else if (*chPtr != surrogate) {
|
||||
/* produce high surrogate, but don't advance source pointer */
|
||||
*chPtr = surrogate;
|
||||
return 0;
|
||||
} else {
|
||||
/* produce high surrogate, advance source pointer */
|
||||
*chPtr = 0xD800 + high;
|
||||
return 1;
|
||||
/* produce low surrogate, and advance source pointer */
|
||||
*chPtr = (Tcl_UniChar) (0xDC00 | (byte & 0x3FF));
|
||||
return 4;
|
||||
}
|
||||
#else
|
||||
*chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
|
||||
*chPtr = (Tcl_UniChar) (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
|
||||
| ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
|
||||
if ((*chPtr - 0x10000) <= 0xFFFFF) {
|
||||
if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) {
|
||||
return 4;
|
||||
}
|
||||
#endif
|
||||
@@ -396,7 +373,7 @@ Tcl_UtfToUniChar(
|
||||
}
|
||||
#endif
|
||||
|
||||
*chPtr = byte;
|
||||
*chPtr = (Tcl_UniChar) byte;
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -427,7 +404,7 @@ Tcl_UtfToUniCharDString(
|
||||
* appended to this previously initialized
|
||||
* DString. */
|
||||
{
|
||||
Tcl_UniChar ch = 0, *w, *wString;
|
||||
Tcl_UniChar ch, *w, *wString;
|
||||
const char *p, *end;
|
||||
int oldLength;
|
||||
|
||||
@@ -441,27 +418,17 @@ Tcl_UtfToUniCharDString(
|
||||
*/
|
||||
|
||||
oldLength = Tcl_DStringLength(dsPtr);
|
||||
|
||||
/* TODO: fix overreach! */
|
||||
Tcl_DStringSetLength(dsPtr,
|
||||
oldLength + (int) ((length + 1) * sizeof(Tcl_UniChar)));
|
||||
(int) ((oldLength + length + 1) * sizeof(Tcl_UniChar)));
|
||||
wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);
|
||||
|
||||
w = wString;
|
||||
p = src;
|
||||
end = src + length - TCL_UTF_MAX;
|
||||
while (p < end) {
|
||||
end = src + length;
|
||||
for (p = src; p < end; ) {
|
||||
p += TclUtfToUniChar(p, &ch);
|
||||
*w++ = ch;
|
||||
}
|
||||
end += TCL_UTF_MAX;
|
||||
while (p < end) {
|
||||
if (Tcl_UtfCharComplete(p, end-p)) {
|
||||
p += TclUtfToUniChar(p, &ch);
|
||||
} else {
|
||||
ch = UCHAR(*p++);
|
||||
}
|
||||
*w++ = ch;
|
||||
}
|
||||
*w = '\0';
|
||||
Tcl_DStringSetLength(dsPtr,
|
||||
(oldLength + ((char *) w - (char *) wString)));
|
||||
@@ -561,13 +528,13 @@ Tcl_NumUtfChars(
|
||||
*
|
||||
* Tcl_UtfFindFirst --
|
||||
*
|
||||
* Returns a pointer to the first occurance of the given Unicode character
|
||||
* in the NULL-terminated UTF-8 string. The NULL terminator is considered
|
||||
* Returns a pointer to the first occurance of the given Tcl_UniChar in
|
||||
* the NULL-terminated UTF-8 string. The NULL terminator is considered
|
||||
* part of the UTF-8 string. Equivalent to Plan 9 utfrune().
|
||||
*
|
||||
* Results:
|
||||
* As above. If the Unicode character does not exist in the given string,
|
||||
* the return value is NULL.
|
||||
* As above. If the Tcl_UniChar does not exist in the given string, the
|
||||
* return value is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
@@ -578,21 +545,14 @@ Tcl_NumUtfChars(
|
||||
const char *
|
||||
Tcl_UtfFindFirst(
|
||||
const char *src, /* The UTF-8 string to be searched. */
|
||||
int ch) /* The Unicode character to search for. */
|
||||
int ch) /* The Tcl_UniChar to search for. */
|
||||
{
|
||||
int len, fullchar;
|
||||
int len;
|
||||
Tcl_UniChar find = 0;
|
||||
|
||||
while (1) {
|
||||
len = TclUtfToUniChar(src, &find);
|
||||
fullchar = find;
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((ch >= 0xD800) && (len < 3)) {
|
||||
len += TclUtfToUniChar(src + len, &find);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
|
||||
}
|
||||
#endif
|
||||
if (fullchar == ch) {
|
||||
if (find == ch) {
|
||||
return src;
|
||||
}
|
||||
if (*src == '\0') {
|
||||
@@ -607,12 +567,12 @@ Tcl_UtfFindFirst(
|
||||
*
|
||||
* Tcl_UtfFindLast --
|
||||
*
|
||||
* Returns a pointer to the last occurance of the given Unicode character
|
||||
* in the NULL-terminated UTF-8 string. The NULL terminator is considered
|
||||
* Returns a pointer to the last occurance of the given Tcl_UniChar in
|
||||
* the NULL-terminated UTF-8 string. The NULL terminator is considered
|
||||
* part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
|
||||
*
|
||||
* Results:
|
||||
* As above. If the Unicode character does not exist in the given string, the
|
||||
* As above. If the Tcl_UniChar does not exist in the given string, the
|
||||
* return value is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
@@ -624,23 +584,16 @@ Tcl_UtfFindFirst(
|
||||
const char *
|
||||
Tcl_UtfFindLast(
|
||||
const char *src, /* The UTF-8 string to be searched. */
|
||||
int ch) /* The Unicode character to search for. */
|
||||
int ch) /* The Tcl_UniChar to search for. */
|
||||
{
|
||||
int len, fullchar;
|
||||
int len;
|
||||
Tcl_UniChar find = 0;
|
||||
const char *last;
|
||||
|
||||
last = NULL;
|
||||
while (1) {
|
||||
len = TclUtfToUniChar(src, &find);
|
||||
fullchar = find;
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((ch >= 0xD800) && (len < 3)) {
|
||||
len += TclUtfToUniChar(src + len, &find);
|
||||
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
|
||||
}
|
||||
#endif
|
||||
if (fullchar == ch) {
|
||||
if (find == ch) {
|
||||
last = src;
|
||||
}
|
||||
if (*src == '\0') {
|
||||
@@ -678,8 +631,8 @@ Tcl_UtfNext(
|
||||
int len = TclUtfToUniChar(src, &ch);
|
||||
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((ch >= 0xD800) && (len < 3)) {
|
||||
len += TclUtfToUniChar(src + len, &ch);
|
||||
if (len == 0) {
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
}
|
||||
#endif
|
||||
return src + len;
|
||||
@@ -740,7 +693,7 @@ Tcl_UtfPrev(
|
||||
*
|
||||
* Tcl_UniCharAtIndex --
|
||||
*
|
||||
* Returns the Tcl_UniChar represented at the specified character
|
||||
* Returns the Unicode character represented at the specified character
|
||||
* (not byte) position in the UTF-8 string.
|
||||
*
|
||||
* Results:
|
||||
@@ -759,7 +712,8 @@ Tcl_UniCharAtIndex(
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
|
||||
while (index-- >= 0) {
|
||||
while (index >= 0) {
|
||||
index--;
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
}
|
||||
return ch;
|
||||
@@ -788,18 +742,11 @@ Tcl_UtfAtIndex(
|
||||
register int index) /* The position of the desired character. */
|
||||
{
|
||||
Tcl_UniChar ch = 0;
|
||||
int len = 0;
|
||||
|
||||
while (index-- > 0) {
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
src += len;
|
||||
}
|
||||
#if TCL_UTF_MAX == 4
|
||||
if ((ch >= 0xD800) && (len < 3)) {
|
||||
/* Index points at character following high Surrogate */
|
||||
while (index > 0) {
|
||||
index--;
|
||||
src += TclUtfToUniChar(src, &ch);
|
||||
}
|
||||
#endif
|
||||
return src;
|
||||
}
|
||||
|
||||
@@ -880,7 +827,7 @@ Tcl_UtfToUpper(
|
||||
{
|
||||
Tcl_UniChar ch = 0, upChar;
|
||||
char *src, *dst;
|
||||
int len;
|
||||
int bytes;
|
||||
|
||||
/*
|
||||
* Iterate over the string until we hit the terminating null.
|
||||
@@ -888,7 +835,7 @@ Tcl_UtfToUpper(
|
||||
|
||||
src = dst = str;
|
||||
while (*src) {
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
bytes = TclUtfToUniChar(src, &ch);
|
||||
upChar = Tcl_UniCharToUpper(ch);
|
||||
|
||||
/*
|
||||
@@ -897,13 +844,13 @@ Tcl_UtfToUpper(
|
||||
* char to dst if its size is <= the original char.
|
||||
*/
|
||||
|
||||
if (len < UtfCount(upChar)) {
|
||||
memcpy(dst, src, len);
|
||||
dst += len;
|
||||
if (bytes < UtfCount(upChar)) {
|
||||
memcpy(dst, src, (size_t) bytes);
|
||||
dst += bytes;
|
||||
} else {
|
||||
dst += Tcl_UniCharToUtf(upChar, dst);
|
||||
}
|
||||
src += len;
|
||||
src += bytes;
|
||||
}
|
||||
*dst = '\0';
|
||||
return (dst - str);
|
||||
@@ -933,7 +880,7 @@ Tcl_UtfToLower(
|
||||
{
|
||||
Tcl_UniChar ch = 0, lowChar;
|
||||
char *src, *dst;
|
||||
int len;
|
||||
int bytes;
|
||||
|
||||
/*
|
||||
* Iterate over the string until we hit the terminating null.
|
||||
@@ -941,7 +888,7 @@ Tcl_UtfToLower(
|
||||
|
||||
src = dst = str;
|
||||
while (*src) {
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
bytes = TclUtfToUniChar(src, &ch);
|
||||
lowChar = Tcl_UniCharToLower(ch);
|
||||
|
||||
/*
|
||||
@@ -950,13 +897,13 @@ Tcl_UtfToLower(
|
||||
* char to dst if its size is <= the original char.
|
||||
*/
|
||||
|
||||
if (len < UtfCount(lowChar)) {
|
||||
memcpy(dst, src, len);
|
||||
dst += len;
|
||||
if (bytes < UtfCount(lowChar)) {
|
||||
memcpy(dst, src, (size_t) bytes);
|
||||
dst += bytes;
|
||||
} else {
|
||||
dst += Tcl_UniCharToUtf(lowChar, dst);
|
||||
}
|
||||
src += len;
|
||||
src += bytes;
|
||||
}
|
||||
*dst = '\0';
|
||||
return (dst - str);
|
||||
@@ -987,7 +934,7 @@ Tcl_UtfToTitle(
|
||||
{
|
||||
Tcl_UniChar ch = 0, titleChar, lowChar;
|
||||
char *src, *dst;
|
||||
int len;
|
||||
int bytes;
|
||||
|
||||
/*
|
||||
* Capitalize the first character and then lowercase the rest of the
|
||||
@@ -997,32 +944,28 @@ Tcl_UtfToTitle(
|
||||
src = dst = str;
|
||||
|
||||
if (*src) {
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
bytes = TclUtfToUniChar(src, &ch);
|
||||
titleChar = Tcl_UniCharToTitle(ch);
|
||||
|
||||
if (len < UtfCount(titleChar)) {
|
||||
memcpy(dst, src, len);
|
||||
dst += len;
|
||||
if (bytes < UtfCount(titleChar)) {
|
||||
memcpy(dst, src, (size_t) bytes);
|
||||
dst += bytes;
|
||||
} else {
|
||||
dst += Tcl_UniCharToUtf(titleChar, dst);
|
||||
}
|
||||
src += len;
|
||||
src += bytes;
|
||||
}
|
||||
while (*src) {
|
||||
len = TclUtfToUniChar(src, &ch);
|
||||
lowChar = ch;
|
||||
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
|
||||
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
|
||||
lowChar = Tcl_UniCharToLower(lowChar);
|
||||
}
|
||||
bytes = TclUtfToUniChar(src, &ch);
|
||||
lowChar = Tcl_UniCharToLower(ch);
|
||||
|
||||
if (len < UtfCount(lowChar)) {
|
||||
memcpy(dst, src, len);
|
||||
dst += len;
|
||||
if (bytes < UtfCount(lowChar)) {
|
||||
memcpy(dst, src, (size_t) bytes);
|
||||
dst += bytes;
|
||||
} else {
|
||||
dst += Tcl_UniCharToUtf(lowChar, dst);
|
||||
}
|
||||
src += len;
|
||||
src += bytes;
|
||||
}
|
||||
*dst = '\0';
|
||||
return (dst - str);
|
||||
@@ -1116,16 +1059,6 @@ Tcl_UtfNcmp(
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX == 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
return (ch1 - ch2);
|
||||
}
|
||||
}
|
||||
@@ -1157,7 +1090,6 @@ Tcl_UtfNcasecmp(
|
||||
unsigned long numChars) /* Number of UTF chars to compare. */
|
||||
{
|
||||
Tcl_UniChar ch1 = 0, ch2 = 0;
|
||||
|
||||
while (numChars-- > 0) {
|
||||
/*
|
||||
* n must be interpreted as chars, not bytes.
|
||||
@@ -1167,16 +1099,6 @@ Tcl_UtfNcasecmp(
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX == 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
ch1 = Tcl_UniCharToLower(ch1);
|
||||
ch2 = Tcl_UniCharToLower(ch2);
|
||||
if (ch1 != ch2) {
|
||||
@@ -1190,7 +1112,7 @@ Tcl_UtfNcasecmp(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclUtfCasecmp --
|
||||
* Tcl_UtfNcasecmp --
|
||||
*
|
||||
* Compare UTF chars of string cs to string ct case insensitively.
|
||||
* Replacement for strcasecmp in Tcl core, in places where UTF-8 should
|
||||
@@ -1210,22 +1132,12 @@ TclUtfCasecmp(
|
||||
const char *cs, /* UTF string to compare to ct. */
|
||||
const char *ct) /* UTF string cs is compared to. */
|
||||
{
|
||||
Tcl_UniChar ch1 = 0, ch2 = 0;
|
||||
|
||||
while (*cs && *ct) {
|
||||
Tcl_UniChar ch1, ch2;
|
||||
|
||||
cs += TclUtfToUniChar(cs, &ch1);
|
||||
ct += TclUtfToUniChar(ct, &ch2);
|
||||
if (ch1 != ch2) {
|
||||
#if TCL_UTF_MAX == 4
|
||||
/* Surrogates always report higher than non-surrogates */
|
||||
if (((ch1 & 0xFC00) == 0xD800)) {
|
||||
if ((ch2 & 0xFC00) != 0xD800) {
|
||||
return ch1;
|
||||
}
|
||||
} else if ((ch2 & 0xFC00) == 0xD800) {
|
||||
return -ch2;
|
||||
}
|
||||
#endif
|
||||
ch1 = Tcl_UniCharToLower(ch1);
|
||||
ch2 = Tcl_UniCharToLower(ch2);
|
||||
if (ch1 != ch2) {
|
||||
@@ -1286,9 +1198,8 @@ Tcl_UniCharToLower(
|
||||
int ch) /* Unicode character to convert. */
|
||||
{
|
||||
int info = GetUniCharInfo(ch);
|
||||
int mode = GetCaseType(info);
|
||||
|
||||
if ((mode & 0x02) && (mode != 0x7)) {
|
||||
if (GetCaseType(info) & 0x02) {
|
||||
ch += GetDelta(info);
|
||||
}
|
||||
return (Tcl_UniChar) ch;
|
||||
@@ -1322,9 +1233,7 @@ Tcl_UniCharToTitle(
|
||||
* Subtract or add one depending on the original case.
|
||||
*/
|
||||
|
||||
if (mode != 0x7) {
|
||||
ch += ((mode & 0x4) ? -1 : 1);
|
||||
}
|
||||
ch += ((mode & 0x4) ? -1 : 1);
|
||||
} else if (mode == 0x4) {
|
||||
ch -= GetDelta(info);
|
||||
}
|
||||
|
||||
+117
-406
@@ -107,8 +107,6 @@ static Tcl_ThreadDataKey precisionKey;
|
||||
static void ClearHash(Tcl_HashTable *tablePtr);
|
||||
static void FreeProcessGlobalValue(ClientData clientData);
|
||||
static void FreeThreadHash(ClientData clientData);
|
||||
static int GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue,
|
||||
int *indexPtr);
|
||||
static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
|
||||
static int SetEndOffsetFromAny(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
@@ -976,7 +974,7 @@ Tcl_ScanCountedElement(
|
||||
int *flagPtr) /* Where to store information to guide
|
||||
* Tcl_ConvertElement. */
|
||||
{
|
||||
char flags = CONVERT_ANY;
|
||||
int flags = CONVERT_ANY;
|
||||
int numBytes = TclScanElement(src, length, &flags);
|
||||
|
||||
*flagPtr = flags;
|
||||
@@ -1017,7 +1015,7 @@ int
|
||||
TclScanElement(
|
||||
const char *src, /* String to convert to Tcl list element. */
|
||||
int length, /* Number of bytes in src, or -1. */
|
||||
char *flagPtr) /* Where to store information to guide
|
||||
int *flagPtr) /* Where to store information to guide
|
||||
* Tcl_ConvertElement. */
|
||||
{
|
||||
const char *p = src;
|
||||
@@ -1046,23 +1044,6 @@ TclScanElement(
|
||||
return 2;
|
||||
}
|
||||
|
||||
#if COMPAT
|
||||
/*
|
||||
* We have an established history in TclConvertElement() when quoting
|
||||
* because of a leading hash character to force what would be the
|
||||
* CONVERT_MASK mode into the CONVERT_BRACE mode. That is, we format
|
||||
* the element #{a"b} like this:
|
||||
* {#{a"b}}
|
||||
* and not like this:
|
||||
* \#{a\"b}
|
||||
* This is inconsistent with [list x{a"b}], but we will not change that now.
|
||||
* Set that preference here so that we compute a tight size requirement.
|
||||
*/
|
||||
if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
|
||||
preferBrace = 1;
|
||||
}
|
||||
#endif
|
||||
|
||||
if ((*p == '{') || (*p == '"')) {
|
||||
/*
|
||||
* Must escape or protect so leading character of value is not
|
||||
@@ -1566,10 +1547,11 @@ Tcl_Merge(
|
||||
int argc, /* How many strings to merge. */
|
||||
const char *const *argv) /* Array of string values. */
|
||||
{
|
||||
#define LOCAL_SIZE 64
|
||||
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
#define LOCAL_SIZE 20
|
||||
int localFlags[LOCAL_SIZE], *flagPtr = NULL;
|
||||
int i, bytesNeeded = 0;
|
||||
char *result, *dst;
|
||||
const int maxFlags = UINT_MAX / sizeof(int);
|
||||
|
||||
/*
|
||||
* Handle empty list case first, so logic of the general case can be
|
||||
@@ -1588,8 +1570,22 @@ Tcl_Merge(
|
||||
|
||||
if (argc <= LOCAL_SIZE) {
|
||||
flagPtr = localFlags;
|
||||
} else if (argc > maxFlags) {
|
||||
/*
|
||||
* We cannot allocate a large enough flag array to format this list in
|
||||
* one pass. We could imagine converting this routine to a multi-pass
|
||||
* implementation, but for sizeof(int) == 4, the limit is a max of
|
||||
* 2^30 list elements and since each element is at least one byte
|
||||
* formatted, and requires one byte space between it and the next one,
|
||||
* that a minimum space requirement of 2^31 bytes, which is already
|
||||
* INT_MAX. If we tried to format a list of > maxFlags elements, we're
|
||||
* just going to overflow the size limits on the formatted string
|
||||
* anyway, so just issue that same panic early.
|
||||
*/
|
||||
|
||||
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
|
||||
} else {
|
||||
flagPtr = ckalloc(argc);
|
||||
flagPtr = ckalloc(argc * sizeof(int));
|
||||
}
|
||||
for (i = 0; i < argc; i++) {
|
||||
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
|
||||
@@ -1649,7 +1645,7 @@ Tcl_Backslash(
|
||||
int *readPtr) /* Fill in with number of characters read from
|
||||
* src, unless NULL. */
|
||||
{
|
||||
char buf[TCL_UTF_MAX] = "";
|
||||
char buf[TCL_UTF_MAX];
|
||||
Tcl_UniChar ch = 0;
|
||||
|
||||
Tcl_UtfBackslash(src, readPtr, buf);
|
||||
@@ -1657,49 +1653,14 @@ Tcl_Backslash(
|
||||
return (char) ch;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* UtfWellFormedEnd --
|
||||
* Checks the end of utf string is malformed, if yes - wraps bytes
|
||||
* to the given buffer (as well-formed NTS string). The buffer
|
||||
* argument should be initialized by the caller and ready to use.
|
||||
*
|
||||
* Results:
|
||||
* The bytes with well-formed end of the string.
|
||||
*
|
||||
* Side effects:
|
||||
* Buffer (DString) may be allocated, so must be released.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline const char*
|
||||
UtfWellFormedEnd(
|
||||
Tcl_DString *buffer, /* Buffer used to hold well-formed string. */
|
||||
const char *bytes, /* Pointer to the beginning of the string. */
|
||||
int length) /* Length of the string. */
|
||||
{
|
||||
const char *l = bytes + length;
|
||||
const char *p = Tcl_UtfPrev(l, bytes);
|
||||
|
||||
if (Tcl_UtfCharComplete(p, l - p)) {
|
||||
return bytes;
|
||||
}
|
||||
/*
|
||||
* Malformed utf-8 end, be sure we've NTS to safe compare of end-character,
|
||||
* avoid segfault by access violation out of range.
|
||||
*/
|
||||
Tcl_DStringAppend(buffer, bytes, length);
|
||||
return Tcl_DStringValue(buffer);
|
||||
}
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclTrimRight --
|
||||
* Takes two counted strings in the Tcl encoding. Conceptually
|
||||
* finds the sub string (offset) to trim from the right side of the
|
||||
* first string all characters found in the second string.
|
||||
*
|
||||
* Takes two counted strings in the Tcl encoding which must both be null
|
||||
* terminated. Conceptually trims from the right side of the first string
|
||||
* all characters found in the second string.
|
||||
*
|
||||
* Results:
|
||||
* The number of bytes to be removed from the end of the string.
|
||||
@@ -1710,8 +1671,8 @@ UtfWellFormedEnd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
TrimRight(
|
||||
int
|
||||
TclTrimRight(
|
||||
const char *bytes, /* String to be trimmed... */
|
||||
int numBytes, /* ...and its length in bytes */
|
||||
const char *trim, /* String of trim characters... */
|
||||
@@ -1720,6 +1681,18 @@ TrimRight(
|
||||
const char *p = bytes + numBytes;
|
||||
int pInc;
|
||||
|
||||
if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
|
||||
Tcl_Panic("TclTrimRight works only on null-terminated strings");
|
||||
}
|
||||
|
||||
/*
|
||||
* Empty strings -> nothing to do.
|
||||
*/
|
||||
|
||||
if ((numBytes == 0) || (numTrim == 0)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Outer loop: iterate over string to be trimmed.
|
||||
*/
|
||||
@@ -1760,46 +1733,15 @@ TrimRight(
|
||||
|
||||
return numBytes - (p - bytes);
|
||||
}
|
||||
|
||||
int
|
||||
TclTrimRight(
|
||||
const char *bytes, /* String to be trimmed... */
|
||||
int numBytes, /* ...and its length in bytes */
|
||||
const char *trim, /* String of trim characters... */
|
||||
int numTrim) /* ...and its length in bytes */
|
||||
{
|
||||
int res;
|
||||
Tcl_DString bytesBuf, trimBuf;
|
||||
|
||||
/* Empty strings -> nothing to do */
|
||||
if ((numBytes == 0) || (numTrim == 0)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
Tcl_DStringInit(&bytesBuf);
|
||||
Tcl_DStringInit(&trimBuf);
|
||||
bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
|
||||
trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);
|
||||
|
||||
res = TrimRight(bytes, numBytes, trim, numTrim);
|
||||
if (res > numBytes) {
|
||||
res = numBytes;
|
||||
}
|
||||
|
||||
Tcl_DStringFree(&bytesBuf);
|
||||
Tcl_DStringFree(&trimBuf);
|
||||
|
||||
return res;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclTrimLeft --
|
||||
*
|
||||
* Takes two counted strings in the Tcl encoding. Conceptually
|
||||
* finds the sub string (offset) to trim from the left side of the
|
||||
* first string all characters found in the second string.
|
||||
* Takes two counted strings in the Tcl encoding which must both be null
|
||||
* terminated. Conceptually trims from the left side of the first string
|
||||
* all characters found in the second string.
|
||||
*
|
||||
* Results:
|
||||
* The number of bytes to be removed from the start of the string.
|
||||
@@ -1810,8 +1752,8 @@ TclTrimRight(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
TrimLeft(
|
||||
int
|
||||
TclTrimLeft(
|
||||
const char *bytes, /* String to be trimmed... */
|
||||
int numBytes, /* ...and its length in bytes */
|
||||
const char *trim, /* String of trim characters... */
|
||||
@@ -1819,6 +1761,18 @@ TrimLeft(
|
||||
{
|
||||
const char *p = bytes;
|
||||
|
||||
if ((bytes[numBytes] != '\0') || (trim[numTrim] != '\0')) {
|
||||
Tcl_Panic("TclTrimLeft works only on null-terminated strings");
|
||||
}
|
||||
|
||||
/*
|
||||
* Empty strings -> nothing to do.
|
||||
*/
|
||||
|
||||
if ((numBytes == 0) || (numTrim == 0)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Outer loop: iterate over string to be trimmed.
|
||||
*/
|
||||
@@ -1855,99 +1809,10 @@ TrimLeft(
|
||||
|
||||
p += pInc;
|
||||
numBytes -= pInc;
|
||||
} while (numBytes > 0);
|
||||
} while (numBytes);
|
||||
|
||||
return p - bytes;
|
||||
}
|
||||
|
||||
int
|
||||
TclTrimLeft(
|
||||
const char *bytes, /* String to be trimmed... */
|
||||
int numBytes, /* ...and its length in bytes */
|
||||
const char *trim, /* String of trim characters... */
|
||||
int numTrim) /* ...and its length in bytes */
|
||||
{
|
||||
int res;
|
||||
Tcl_DString bytesBuf, trimBuf;
|
||||
|
||||
/* Empty strings -> nothing to do */
|
||||
if ((numBytes == 0) || (numTrim == 0)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
Tcl_DStringInit(&bytesBuf);
|
||||
Tcl_DStringInit(&trimBuf);
|
||||
bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
|
||||
trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);
|
||||
|
||||
res = TrimLeft(bytes, numBytes, trim, numTrim);
|
||||
if (res > numBytes) {
|
||||
res = numBytes;
|
||||
}
|
||||
|
||||
Tcl_DStringFree(&bytesBuf);
|
||||
Tcl_DStringFree(&trimBuf);
|
||||
|
||||
return res;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclTrim --
|
||||
* Finds the sub string (offset) to trim from both sides of the
|
||||
* first string all characters found in the second string.
|
||||
*
|
||||
* Results:
|
||||
* The number of bytes to be removed from the start of the string
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclTrim(
|
||||
const char *bytes, /* String to be trimmed... */
|
||||
int numBytes, /* ...and its length in bytes */
|
||||
const char *trim, /* String of trim characters... */
|
||||
int numTrim, /* ...and its length in bytes */
|
||||
int *trimRight) /* Offset from the end of the string. */
|
||||
{
|
||||
int trimLeft;
|
||||
Tcl_DString bytesBuf, trimBuf;
|
||||
|
||||
*trimRight = 0;
|
||||
/* Empty strings -> nothing to do */
|
||||
if ((numBytes == 0) || (numTrim == 0)) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
Tcl_DStringInit(&bytesBuf);
|
||||
Tcl_DStringInit(&trimBuf);
|
||||
bytes = UtfWellFormedEnd(&bytesBuf, bytes, numBytes);
|
||||
trim = UtfWellFormedEnd(&trimBuf, trim, numTrim);
|
||||
|
||||
trimLeft = TrimLeft(bytes, numBytes, trim, numTrim);
|
||||
if (trimLeft > numBytes) {
|
||||
trimLeft = numBytes;
|
||||
}
|
||||
numBytes -= trimLeft;
|
||||
/* have to trim yet (first char was already verified within TrimLeft) */
|
||||
if (numBytes > 1) {
|
||||
bytes += trimLeft;
|
||||
*trimRight = TrimRight(bytes, numBytes, trim, numTrim);
|
||||
if (*trimRight > numBytes) {
|
||||
*trimRight = numBytes;
|
||||
}
|
||||
}
|
||||
|
||||
Tcl_DStringFree(&bytesBuf);
|
||||
Tcl_DStringFree(&trimBuf);
|
||||
|
||||
return trimLeft;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -2015,20 +1880,30 @@ Tcl_Concat(
|
||||
result = ckalloc((unsigned) (bytesNeeded + argc));
|
||||
|
||||
for (p = result, i = 0; i < argc; i++) {
|
||||
int triml, trimr, elemLength;
|
||||
int trim, elemLength;
|
||||
const char *element;
|
||||
|
||||
element = argv[i];
|
||||
elemLength = strlen(argv[i]);
|
||||
|
||||
/* Trim away the leading/trailing whitespace. */
|
||||
triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE, &trimr);
|
||||
element += triml;
|
||||
elemLength -= triml + trimr;
|
||||
/*
|
||||
* Trim away the leading whitespace.
|
||||
*/
|
||||
|
||||
/* Do not permit trimming to expose a final backslash character. */
|
||||
elemLength += trimr && (element[elemLength - 1] == '\\');
|
||||
trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
element += trim;
|
||||
elemLength -= trim;
|
||||
|
||||
/*
|
||||
* Trim away the trailing whitespace. Do not permit trimming to expose
|
||||
* a final backslash character.
|
||||
*/
|
||||
|
||||
trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
trim -= trim && (element[elemLength - trim - 1] == '\\');
|
||||
elemLength -= trim;
|
||||
|
||||
/*
|
||||
* If we're left with empty element after trimming, do nothing.
|
||||
@@ -2148,18 +2023,28 @@ Tcl_ConcatObj(
|
||||
Tcl_SetObjLength(resPtr, 0);
|
||||
|
||||
for (i = 0; i < objc; i++) {
|
||||
int triml, trimr;
|
||||
int trim;
|
||||
|
||||
element = TclGetStringFromObj(objv[i], &elemLength);
|
||||
|
||||
/* Trim away the leading/trailing whitespace. */
|
||||
triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE, &trimr);
|
||||
element += triml;
|
||||
elemLength -= triml + trimr;
|
||||
/*
|
||||
* Trim away the leading whitespace.
|
||||
*/
|
||||
|
||||
/* Do not permit trimming to expose a final backslash character. */
|
||||
elemLength += trimr && (element[elemLength - 1] == '\\');
|
||||
trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
element += trim;
|
||||
elemLength -= trim;
|
||||
|
||||
/*
|
||||
* Trim away the trailing whitespace. Do not permit trimming to expose
|
||||
* a final backslash character.
|
||||
*/
|
||||
|
||||
trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
trim -= trim && (element[elemLength - trim - 1] == '\\');
|
||||
elemLength -= trim;
|
||||
|
||||
/*
|
||||
* If we're left with empty element after trimming, do nothing.
|
||||
@@ -2660,8 +2545,7 @@ TclStringMatchObj(
|
||||
udata = Tcl_GetUnicodeFromObj(strObj, &length);
|
||||
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
|
||||
match = TclUniCharMatch(udata, length, uptn, plen, flags);
|
||||
} else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
|
||||
&& !flags) {
|
||||
} else if (TclIsPureByteArray(strObj) && !flags) {
|
||||
unsigned char *data, *ptn;
|
||||
|
||||
data = Tcl_GetByteArrayFromObj(strObj, &length);
|
||||
@@ -2833,7 +2717,7 @@ Tcl_DStringAppendElement(
|
||||
{
|
||||
char *dst = dsPtr->string + dsPtr->length;
|
||||
int needSpace = TclNeedSpace(dsPtr->string, dst);
|
||||
char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
|
||||
int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
|
||||
int newSize = dsPtr->length + needSpace
|
||||
+ TclScanElement(element, -1, &flags);
|
||||
|
||||
@@ -3661,27 +3545,22 @@ TclFormatInt(
|
||||
*
|
||||
* TclGetIntForIndex --
|
||||
*
|
||||
* Provides an integer corresponding to the list index held in a Tcl
|
||||
* object. The string value 'objPtr' is expected have the format
|
||||
* integer([+-]integer)? or end([+-]integer)?.
|
||||
* This function returns an integer corresponding to the list index held
|
||||
* in a Tcl object. The Tcl object's value is expected to be in the
|
||||
* format integer([+-]integer)? or the format end([+-]integer)?.
|
||||
*
|
||||
* Results:
|
||||
* The return value is normally TCL_OK, which means that the index was
|
||||
* successfully stored into the location referenced by "indexPtr". If the
|
||||
* Tcl object referenced by "objPtr" has the value "end", the value
|
||||
* stored is "endValue". If "objPtr"s values is not of one of the
|
||||
* expected formats, TCL_ERROR is returned and, if "interp" is non-NULL,
|
||||
* an error message is left in the interpreter's result object.
|
||||
*
|
||||
* Side effects:
|
||||
* The object referenced by "objPtr" might be converted to an integer,
|
||||
* wide integer, or end-based-index object.
|
||||
*
|
||||
* Value
|
||||
* TCL_OK
|
||||
*
|
||||
* The index is stored at the address given by by 'indexPtr'. If
|
||||
* 'objPtr' has the value "end", the value stored is 'endValue'.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* The value of 'objPtr' does not have one of the expected formats. If
|
||||
* 'interp' is non-NULL, an error message is left in the interpreter's
|
||||
* result object.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The object referenced by 'objPtr' is converted, as needed, to an
|
||||
* integer, wide integer, or end-based-index object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
@@ -3705,7 +3584,13 @@ TclGetIntForIndex(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) {
|
||||
if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
|
||||
/*
|
||||
* If the object is already an offset from the end of the list, or can
|
||||
* be converted to one, use it.
|
||||
*/
|
||||
|
||||
*indexPtr = endValue + objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -3805,41 +3690,6 @@ UpdateStringOfEndOffset(
|
||||
objPtr->length = len;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* GetEndOffsetFromObj --
|
||||
*
|
||||
* Look for a string of the form "end[+-]offset" and convert it to an
|
||||
* internal representation holding the offset.
|
||||
*
|
||||
* Results:
|
||||
* Tcl return code.
|
||||
*
|
||||
* Side effects:
|
||||
* May store a Tcl_ObjType.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
GetEndOffsetFromObj(
|
||||
Tcl_Obj *objPtr, /* Pointer to the object to parse */
|
||||
int endValue, /* The value to be stored at "indexPtr" if
|
||||
* "objPtr" holds "end". */
|
||||
int *indexPtr) /* Location filled in with an integer
|
||||
* representing an index. */
|
||||
{
|
||||
if (SetEndOffsetFromAny(NULL, objPtr) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* TODO: Handle overflow cases sensibly */
|
||||
*indexPtr = endValue + (int)objPtr->internalRep.longValue;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3909,8 +3759,6 @@ SetEndOffsetFromAny(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (bytes[3] == '-') {
|
||||
|
||||
/* TODO: Review overflow concerns here! */
|
||||
offset = -offset;
|
||||
}
|
||||
} else {
|
||||
@@ -3939,143 +3787,6 @@ SetEndOffsetFromAny(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclIndexEncode --
|
||||
*
|
||||
* Parse objPtr to determine if it is an index value. Two cases
|
||||
* are possible. The value objPtr might be parsed as an absolute
|
||||
* index value in the C signed int range. Note that this includes
|
||||
* index values that are integers as presented and it includes index
|
||||
* arithmetic expressions. The absolute index values that can be
|
||||
* directly meaningful as an index into either a list or a string are
|
||||
* those integer values >= TCL_INDEX_START (0)
|
||||
* and < TCL_INDEX_AFTER (INT_MAX).
|
||||
* The largest string supported in Tcl 8 has bytelength INT_MAX.
|
||||
* This means the largest supported character length is also INT_MAX,
|
||||
* and the index of the last character in a string of length INT_MAX
|
||||
* is INT_MAX-1.
|
||||
*
|
||||
* Any absolute index value parsed outside that range is encoded
|
||||
* using the before and after values passed in by the
|
||||
* caller as the encoding to use for indices that are either
|
||||
* less than or greater than the usable index range. TCL_INDEX_AFTER
|
||||
* is available as a good choice for most callers to use for
|
||||
* after. Likewise, the value TCL_INDEX_BEFORE is good for
|
||||
* most callers to use for before. Other values are possible
|
||||
* when the caller knows it is helpful in producing its own behavior
|
||||
* for indices before and after the indexed item.
|
||||
*
|
||||
* A token can also be parsed as an end-relative index expression.
|
||||
* All end-relative expressions that indicate an index larger
|
||||
* than end (end+2, end--5) point beyond the end of the indexed
|
||||
* collection, and can be encoded as after. The end-relative
|
||||
* expressions that indicate an index less than or equal to end
|
||||
* are encoded relative to the value TCL_INDEX_END (-2). The
|
||||
* index "end" is encoded as -2, down to the index "end-0x7ffffffe"
|
||||
* which is encoded as INT_MIN. Since the largest index into a
|
||||
* string possible in Tcl 8 is 0x7ffffffe, the interpretation of
|
||||
* "end-0x7ffffffe" for that largest string would be 0. Thus,
|
||||
* if the tokens "end-0x7fffffff" or "end+-0x80000000" are parsed,
|
||||
* they can be encoded with the before value.
|
||||
*
|
||||
* These details will require re-examination whenever string and
|
||||
* list length limits are increased, but that will likely also
|
||||
* mean a revised routine capable of returning Tcl_WideInt values.
|
||||
*
|
||||
* 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 *indexPtr.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclIndexEncode(
|
||||
Tcl_Interp *interp, /* For error reporting, may be NULL */
|
||||
Tcl_Obj *objPtr, /* Index value to parse */
|
||||
int before, /* Value to return for index before beginning */
|
||||
int after, /* Value to return for index after end */
|
||||
int *indexPtr) /* Where to write the encoded answer, not NULL */
|
||||
{
|
||||
int idx;
|
||||
|
||||
if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &idx)) {
|
||||
/* We parsed a value in the range INT_MIN...INT_MAX */
|
||||
integerEncode:
|
||||
if (idx < TCL_INDEX_START) {
|
||||
/* All negative absolute indices are "before the beginning" */
|
||||
idx = before;
|
||||
} else if (idx == INT_MAX) {
|
||||
/* This index value is always "after the end" */
|
||||
idx = after;
|
||||
}
|
||||
/* usual case, the absolute index value encodes itself */
|
||||
} else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) {
|
||||
/*
|
||||
* We parsed an end+offset index value.
|
||||
* idx holds the offset value in the range INT_MIN...INT_MAX.
|
||||
*/
|
||||
if (idx > 0) {
|
||||
/*
|
||||
* All end+postive or end-negative expressions
|
||||
* always indicate "after the end".
|
||||
*/
|
||||
idx = after;
|
||||
} else if (idx < INT_MIN - TCL_INDEX_END) {
|
||||
/* These indices always indicate "before the beginning */
|
||||
idx = before;
|
||||
} else {
|
||||
/* Encoded end-positive (or end+negative) are offset */
|
||||
idx += TCL_INDEX_END;
|
||||
}
|
||||
|
||||
/* TODO: Consider flag to suppress repeated end-offset parse. */
|
||||
} else if (TCL_OK == TclGetIntForIndexM(interp, objPtr, 0, &idx)) {
|
||||
/*
|
||||
* Only reach this case when the index value is a
|
||||
* constant index arithmetic expression, and idx
|
||||
* holds the result. Treat it the same as if it were
|
||||
* parsed as an absolute integer value.
|
||||
*/
|
||||
goto integerEncode;
|
||||
} else {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
*indexPtr = idx;
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclIndexDecode --
|
||||
*
|
||||
* Decodes a value previously encoded by TclIndexEncode. The argument
|
||||
* endValue indicates what value of "end" should be used in the
|
||||
* decoding.
|
||||
*
|
||||
* Results:
|
||||
* The decoded index value.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclIndexDecode(
|
||||
int encoded, /* Value to decode */
|
||||
int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */
|
||||
{
|
||||
if (encoded <= TCL_INDEX_END) {
|
||||
return (encoded - TCL_INDEX_END) + endValue;
|
||||
}
|
||||
return encoded;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+898
-288
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -1488,7 +1488,7 @@ Tcl_ZlibStreamGet(
|
||||
count = 0;
|
||||
for (i=0; i<listLen; i++) {
|
||||
Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
|
||||
(void) Tcl_GetByteArrayFromObj(itemObj, &itemLen);
|
||||
itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
|
||||
if (i == 0) {
|
||||
count += itemLen - zshPtr->outPos;
|
||||
} else {
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
if {([info commands ::tcl::pkgconfig] eq "")
|
||||
|| ([info sharedlibextension] ne ".dll")} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
|
||||
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
|
||||
} else {
|
||||
package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
|
||||
package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
|
||||
}
|
||||
|
||||
+331
-2174
File diff suppressed because it is too large
Load Diff
@@ -1,2 +1,2 @@
|
||||
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
|
||||
package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
package ifneeded http 2.8.12 [list tclPkgSetup $dir http 2.8.12 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
|
||||
|
||||
+3
-3
@@ -16,7 +16,7 @@
|
||||
if {[info commands package] == ""} {
|
||||
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
|
||||
}
|
||||
package require -exact Tcl 8.6.9
|
||||
package require -exact Tcl 8.6.7
|
||||
|
||||
# Compute the auto path to use in this interpreter.
|
||||
# The values on the path come from several locations:
|
||||
@@ -637,8 +637,8 @@ proc auto_execok name {
|
||||
}
|
||||
set auto_execs($name) ""
|
||||
|
||||
set shellBuiltins [list assoc cls copy date del dir echo erase ftype \
|
||||
md mkdir mklink move rd ren rename rmdir start time type ver vol]
|
||||
set shellBuiltins [list cls copy date del dir echo erase md mkdir \
|
||||
mklink rd ren rename rmdir start time type ver vol]
|
||||
if {[info exists env(PATHEXT)]} {
|
||||
# Add an initial ; to have the {} extension check first.
|
||||
set execExtensions [split ";$env(PATHEXT)" ";"]
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
if {([info commands ::tcl::pkgconfig] eq "")
|
||||
|| ([info sharedlibextension] ne ".dll")} return
|
||||
if {[::tcl::pkgconfig get debug]} {
|
||||
package ifneeded registry 1.3.3 \
|
||||
package ifneeded registry 1.3.2 \
|
||||
[list load [file join $dir tclreg13g.dll] registry]
|
||||
} else {
|
||||
package ifneeded registry 1.3.3 \
|
||||
package ifneeded registry 1.3.2 \
|
||||
[list load [file join $dir tclreg13.dll] registry]
|
||||
}
|
||||
|
||||
@@ -8,5 +8,5 @@
|
||||
# script is sourced, the variable $dir must contain the
|
||||
# full path name of this file's directory.
|
||||
|
||||
if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
|
||||
package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]]
|
||||
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
|
||||
package ifneeded tcltest 2.4.1 [list source [file join $dir tcltest.tcl]]
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user