Compare commits
141
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
ee6540e9cb | ||
|
|
97ef11cb6e | ||
|
|
cb2a1e4c13 | ||
|
|
a62fd8466e | ||
|
|
c7a7120587 | ||
|
|
bef17eed6a | ||
|
|
6bcc85f28e | ||
|
|
4a58d3c00a | ||
|
|
4840e7dbb4 | ||
|
|
282de06cab | ||
|
|
8f14151916 | ||
|
|
ada7d66e9f | ||
|
|
1a8dc819d6 | ||
|
|
6e09fe5ab9 | ||
|
|
fa1ab4f740 | ||
|
|
c91f173c8b | ||
|
|
47f1107ebc | ||
|
|
78bbf020ea | ||
|
|
f0882154a8 | ||
|
|
89583a6623 | ||
|
|
0258413bde | ||
|
|
b6ae0212a1 | ||
|
|
5ff110b484 | ||
|
|
438b687249 | ||
|
|
8c3bcfe950 | ||
|
|
cacb796441 | ||
|
|
40094302e0 | ||
|
|
c7569e1c35 | ||
|
|
ae659fdb12 | ||
|
|
fc5e6debde | ||
|
|
876dd3ac96 | ||
|
|
8c665116c9 | ||
|
|
1eb2dfe0fc | ||
|
|
f53e4a7a0e | ||
|
|
5be047220d | ||
|
|
510244810f | ||
|
|
9f92115d2d | ||
|
|
ad8e3dcb0a | ||
|
|
f77ffeb9b2 | ||
|
|
c574af192d | ||
|
|
fd4bc0f106 | ||
|
|
cca7f018e0 | ||
|
|
e12cc95f12 | ||
|
|
beb8c62dff | ||
|
|
684c2c9051 | ||
|
|
767efbf478 | ||
|
|
b4b95b976a | ||
|
|
2c59046c95 | ||
|
|
f11f5780e0 | ||
|
|
c00d7aa9b9 | ||
|
|
050c8a639f | ||
|
|
248247d828 | ||
|
|
42f972d403 | ||
|
|
a92cc7b340 | ||
|
|
b6ac569a5d | ||
|
|
2c00f457ae | ||
|
|
4a8456e406 | ||
|
|
63d77c0046 | ||
|
|
cc6eaf6308 | ||
|
|
6597355ad8 | ||
|
|
c53002fe3b | ||
|
|
2c2a7d737a | ||
|
|
d250eba26d | ||
|
|
2585021472 | ||
|
|
518e457db3 | ||
|
|
4e83fe1049 | ||
|
|
5d9939831c | ||
|
|
f4549b8fc4 | ||
|
|
c25181bd7d | ||
|
|
2ceb7a6077 | ||
|
|
e3bde55a0f | ||
|
|
834d5da992 | ||
|
|
2be298f89d | ||
|
|
c9ae8d64d3 | ||
|
|
477af49f88 | ||
|
|
7716fd3e46 | ||
|
|
8fc4750efc | ||
|
|
78b4196767 | ||
|
|
1e9a5591d9 | ||
|
|
128e4211ae | ||
|
|
88b2f7f06e | ||
|
|
a994cc42f5 | ||
|
|
12945e9a16 | ||
|
|
2803a8a055 | ||
|
|
29ae06c2d3 | ||
|
|
48459b2357 | ||
|
|
8f95efa4cf | ||
|
|
c8e62b1cfa | ||
|
|
cbc312324e | ||
|
|
03ecb591a6 | ||
|
|
6bb7b1e15d | ||
|
|
a2e12b4377 | ||
|
|
6d9846f8c9 | ||
|
|
666deab1ea | ||
|
|
bb9e19e6eb | ||
|
|
ea8a9ba071 | ||
|
|
430c9bc178 | ||
|
|
e7e7bafe96 | ||
|
|
9c349ce2e2 | ||
|
|
e7f9c9c822 | ||
|
|
83fcae9bbe | ||
|
|
d5961a83e0 | ||
|
|
9c6b83d5b1 | ||
|
|
8a115927af | ||
|
|
68cab10668 | ||
|
|
c28c2d5b9a | ||
|
|
78f85049ff | ||
|
|
a30f092ea3 | ||
|
|
4f13f826e4 | ||
|
|
1c54736c0d | ||
|
|
f9dd75e79c | ||
|
|
d423ce0c06 | ||
|
|
76b954ec41 | ||
|
|
c45f1130d1 | ||
|
|
0891bbbcbb | ||
|
|
05feb2c73f | ||
|
|
0e49a49b8f | ||
|
|
57dc79f34e | ||
|
|
413a0c2501 | ||
|
|
76007824cc | ||
|
|
db5995b2b8 | ||
|
|
9083b5bf61 | ||
|
|
4ad593f2bf | ||
|
|
cdacc33cbb | ||
|
|
f7157671ce | ||
|
|
b004b21242 | ||
|
|
ffb2a3d9b4 | ||
|
|
0eb33efc7a | ||
|
|
53baa9e5c4 | ||
|
|
af735a0ba9 | ||
|
|
a7b60b26f1 | ||
|
|
d6bd07fecc | ||
|
|
f497ce9a95 | ||
|
|
414163addc | ||
|
|
71fd534215 | ||
|
|
b8bcc352ea | ||
|
|
f04eef80d7 | ||
|
|
2de2d8678f | ||
|
|
d5e04d6200 | ||
|
|
6d14b815b2 | ||
|
|
ed18777278 |
Regular → Executable
Regular → Executable
Executable → Regular
Executable → Regular
+27
-7
@@ -14,10 +14,21 @@ encoding \- Manipulate encodings
|
||||
.BE
|
||||
.SH INTRODUCTION
|
||||
.PP
|
||||
Strings in Tcl are encoded using 16-bit Unicode characters. Different
|
||||
operating system interfaces or applications may generate strings in
|
||||
other encodings such as Shift-JIS. The \fBencoding\fR command helps
|
||||
to bridge the gap between Unicode and these other formats.
|
||||
Strings in Tcl are logically a sequence of 16-bit Unicode characters.
|
||||
These strings are represented in memory as a sequence of bytes that
|
||||
may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
|
||||
bytes per character), 16-bit
|
||||
.QW Unicode
|
||||
(which uses 2 bytes per character, with an endianness that is
|
||||
dependent on the host architecture), and binary (which uses a single
|
||||
byte per character but only handles a restricted range of characters).
|
||||
Tcl does not guarantee to always use the same encoding for the same
|
||||
string.
|
||||
.PP
|
||||
Different operating system interfaces or applications may generate
|
||||
strings in other encodings such as Shift\-JIS. The \fBencoding\fR
|
||||
command helps to bridge the gap between Unicode and these other
|
||||
formats.
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Performs one of several encoding related operations, depending on
|
||||
@@ -37,8 +48,9 @@ system encoding is used.
|
||||
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
|
||||
The result is a sequence of bytes that represents the converted
|
||||
string. Each byte is stored in the lower 8-bits of a Unicode
|
||||
character. If \fIencoding\fR is not specified, the current
|
||||
system encoding is used.
|
||||
character (indeed, the resulting string is a binary string as far as
|
||||
Tcl is concerned, at least initially). If \fIencoding\fR is not
|
||||
specified, the current system encoding is used.
|
||||
.TP
|
||||
\fBencoding dirs\fR ?\fIdirectoryList\fR?
|
||||
.
|
||||
@@ -56,6 +68,11 @@ searchable directory, that element is ignored.
|
||||
.
|
||||
Returns a list containing the names of all of the encodings that are
|
||||
currently available.
|
||||
The encodings
|
||||
.QW utf-8
|
||||
and
|
||||
.QW iso8859-1
|
||||
are guaranteed to be present in the list.
|
||||
.TP
|
||||
\fBencoding system\fR ?\fIencoding\fR?
|
||||
.
|
||||
@@ -73,7 +90,7 @@ However, because the \fBsource\fR command always reads files using the
|
||||
current system encoding, Tcl will only source such files correctly
|
||||
when the encoding used to write the file is the same. This tends not
|
||||
to be true in an internationalized setting. For example, if such a
|
||||
file was sourced in North America (where the ISO8859-1 is normally
|
||||
file was sourced in North America (where the ISO8859\-1 is normally
|
||||
used), each byte in the file would be treated as a separate character
|
||||
that maps to the 00 page in Unicode. The resulting Tcl strings will
|
||||
not contain the expected Japanese characters. Instead, they will
|
||||
@@ -93,3 +110,6 @@ which is the Hiragana letter HA.
|
||||
Tcl_GetEncoding(3)
|
||||
.SH KEYWORDS
|
||||
encoding, unicode
|
||||
.\" Local Variables:
|
||||
.\" mode: nroff
|
||||
.\" End:
|
||||
|
||||
Executable → Regular
+24
-4
@@ -343,10 +343,13 @@ misleading.
|
||||
\fBstring bytelength \fIstring\fR
|
||||
.
|
||||
Returns a decimal string giving the number of bytes used to represent
|
||||
\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to
|
||||
represent Unicode characters, the byte length will not be the same as
|
||||
the character length in general. The cases where a script cares about
|
||||
the byte length are rare.
|
||||
\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
|
||||
Tcl may use other encodings for \fIstring\fR as well, and does not
|
||||
guarantee to only use a single encoding for a particular \fIstring\fR.
|
||||
Because UTF\-8 uses a variable number of bytes to represent Unicode
|
||||
characters, the byte length will not be the same as the character
|
||||
length in general. The cases where a script cares about the byte
|
||||
length are rare.
|
||||
.RS
|
||||
.PP
|
||||
In almost all cases, you should use the
|
||||
@@ -354,10 +357,27 @@ In almost all cases, you should use the
|
||||
Tcl byte array value). Refer to the \fBTcl_NumUtfChars\fR manual
|
||||
entry for more details on the UTF\-8 representation.
|
||||
.PP
|
||||
Formally, the \fBstring bytelength\fR operation returns the content of
|
||||
the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
|
||||
\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
|
||||
This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
|
||||
encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
|
||||
denormalized NUL (identical to that used in a number of places by
|
||||
Java's serialization mechanism) to enable basic processing with
|
||||
non-Unicode-aware C functions. As this representation should only
|
||||
ever be used by Tcl's implementation, the number of bytes used to
|
||||
store the representation is of very low value (except to C extension
|
||||
code, which has direct access for the purpose of memory management,
|
||||
etc.)
|
||||
.PP
|
||||
\fICompatibility note:\fR it is likely that this subcommand will be
|
||||
withdrawn in a future version of Tcl. It is better to use the
|
||||
\fBencoding convertto\fR command to convert a string to a known
|
||||
encoding and then apply \fBstring length\fR to that.
|
||||
.PP
|
||||
.CS
|
||||
\fBstring length\fR [encoding convertto utf-8 $theString]
|
||||
.CE
|
||||
.RE
|
||||
.TP
|
||||
\fBstring wordend \fIstring charIndex\fR
|
||||
|
||||
+1
-1
@@ -10,7 +10,7 @@
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceEval, tcl_wordchars, tcl_version \- Variables used by Tcl
|
||||
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_precision, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
|
||||
+16
-19
@@ -67,15 +67,12 @@ extern "C" {
|
||||
* We use this method because there is no autoconf equivalent.
|
||||
*/
|
||||
|
||||
#ifndef __WIN32__
|
||||
# if defined(_WIN32) || defined(WIN32) || defined(__MINGW32__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
|
||||
#ifdef _WIN32
|
||||
# ifndef __WIN32__
|
||||
# define __WIN32__
|
||||
# ifndef WIN32
|
||||
# define WIN32
|
||||
# endif
|
||||
# ifndef _WIN32
|
||||
# define _WIN32
|
||||
# endif
|
||||
# endif
|
||||
# ifndef WIN32
|
||||
# define WIN32
|
||||
# endif
|
||||
#endif
|
||||
|
||||
@@ -83,11 +80,11 @@ extern "C" {
|
||||
* STRICT: See MSDN Article Q83456
|
||||
*/
|
||||
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
# ifndef STRICT
|
||||
# define STRICT
|
||||
# endif
|
||||
#endif /* __WIN32__ */
|
||||
#endif /* _WIN32 */
|
||||
|
||||
/*
|
||||
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
|
||||
@@ -191,7 +188,7 @@ extern "C" {
|
||||
* MSVCRT.
|
||||
*/
|
||||
|
||||
#if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
|
||||
#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
|
||||
# define HAVE_DECLSPEC 1
|
||||
# ifdef STATIC_BUILD
|
||||
# define DLLIMPORT
|
||||
@@ -315,14 +312,14 @@ extern "C" {
|
||||
* VOID. This block is skipped under Cygwin and Mingw.
|
||||
*/
|
||||
|
||||
#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
|
||||
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
|
||||
#ifndef VOID
|
||||
#define VOID void
|
||||
typedef char CHAR;
|
||||
typedef short SHORT;
|
||||
typedef long LONG;
|
||||
#endif
|
||||
#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */
|
||||
#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
|
||||
|
||||
/*
|
||||
* Macro to use instead of "void" for arguments that must have type "void *"
|
||||
@@ -390,7 +387,7 @@ typedef long LONG;
|
||||
*/
|
||||
|
||||
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
|
||||
# if defined(__WIN32__)
|
||||
# if defined(_WIN32)
|
||||
# define TCL_WIDE_INT_TYPE __int64
|
||||
# ifdef __BORLANDC__
|
||||
# define TCL_LL_MODIFIER "L"
|
||||
@@ -400,7 +397,7 @@ typedef long LONG;
|
||||
# elif defined(__GNUC__)
|
||||
# define TCL_WIDE_INT_TYPE long long
|
||||
# define TCL_LL_MODIFIER "ll"
|
||||
# else /* ! __WIN32__ && ! __GNUC__ */
|
||||
# else /* ! _WIN32 && ! __GNUC__ */
|
||||
/*
|
||||
* Don't know what platform it is and configure hasn't discovered what is
|
||||
* going on for us. Try to guess...
|
||||
@@ -415,7 +412,7 @@ typedef long LONG;
|
||||
# define TCL_WIDE_INT_TYPE long long
|
||||
# endif
|
||||
# endif /* NO_LIMITS_H */
|
||||
# endif /* __WIN32__ */
|
||||
# endif /* _WIN32 */
|
||||
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
# undef TCL_WIDE_INT_TYPE
|
||||
@@ -447,7 +444,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
# define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
|
||||
#endif /* TCL_WIDE_INT_IS_LONG */
|
||||
|
||||
#if defined(__WIN32__)
|
||||
#if defined(_WIN32)
|
||||
# ifdef __BORLANDC__
|
||||
typedef struct stati64 Tcl_StatBuf;
|
||||
# elif defined(_WIN64)
|
||||
@@ -562,7 +559,7 @@ typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
|
||||
* will be called as the main fuction of the new thread created by that call.
|
||||
*/
|
||||
|
||||
#if defined __WIN32__
|
||||
#if defined _WIN32
|
||||
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (ClientData clientData);
|
||||
#else
|
||||
typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
|
||||
@@ -574,7 +571,7 @@ typedef void (Tcl_ThreadCreateProc) (ClientData clientData);
|
||||
* in generic/tclThreadTest.c for it's usage.
|
||||
*/
|
||||
|
||||
#if defined __WIN32__
|
||||
#if defined _WIN32
|
||||
# define Tcl_ThreadCreateType unsigned __stdcall
|
||||
# define TCL_THREAD_CREATE_RETURN return 0
|
||||
#else
|
||||
|
||||
+13
-7
@@ -26,6 +26,7 @@
|
||||
*- jumpTable testing
|
||||
*- syntax (?)
|
||||
*- returnCodeBranch
|
||||
*- tclooNext, tclooNextClass
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
@@ -49,7 +50,7 @@ typedef enum BasicBlockCatchState {
|
||||
BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */
|
||||
BBCS_NONE, /* Block is outside of any catch */
|
||||
BBCS_INCATCH, /* Block is within a catch context */
|
||||
BBCS_CAUGHT, /* Block is within a catch context and
|
||||
BBCS_CAUGHT /* Block is within a catch context and
|
||||
* may be executed after an exception fires */
|
||||
} BasicBlockCatchState;
|
||||
|
||||
@@ -120,7 +121,7 @@ enum BasicBlockFlags {
|
||||
* marking it as the start of a 'catch'
|
||||
* sequence. The 'jumpTarget' is the exception
|
||||
* exit from the catch block. */
|
||||
BB_ENDCATCH = (1 << 5), /* Block ends with an 'endCatch' instruction,
|
||||
BB_ENDCATCH = (1 << 5) /* Block ends with an 'endCatch' instruction,
|
||||
* unwinding the catch from the exception
|
||||
* stack. */
|
||||
};
|
||||
@@ -183,7 +184,7 @@ typedef enum TalInstType {
|
||||
* produces N */
|
||||
ASSEM_SINT1, /* One 1-byte signed-integer operand
|
||||
* (INCR_STK_IMM) */
|
||||
ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by
|
||||
ASSEM_SINT4_LVT4 /* Signed 4-byte integer operand followed by
|
||||
* LVT entry. Fixed arity */
|
||||
} TalInstType;
|
||||
|
||||
@@ -437,6 +438,8 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
{"nop", ASSEM_1BYTE, INST_NOP, 0, 0},
|
||||
{"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
|
||||
{"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1},
|
||||
{"numericType", ASSEM_1BYTE, INST_NUM_TYPE, 1, 1},
|
||||
{"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1},
|
||||
{"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1},
|
||||
{"pop", ASSEM_1BYTE, INST_POP, 1, 0},
|
||||
{"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1},
|
||||
@@ -453,9 +456,9 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
| INST_STORE_ARRAY4), 2, 1},
|
||||
{"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1},
|
||||
{"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1},
|
||||
{"strLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
|
||||
{"strTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
|
||||
{"strUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
|
||||
{"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1},
|
||||
{"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1},
|
||||
{"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1},
|
||||
{"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1},
|
||||
{"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1},
|
||||
{"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1},
|
||||
@@ -466,6 +469,7 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
{"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1},
|
||||
{"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1},
|
||||
{"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1},
|
||||
{"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1},
|
||||
{"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1},
|
||||
{"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1},
|
||||
{"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1},
|
||||
@@ -475,6 +479,7 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
{"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1},
|
||||
{"tclooNamespace", ASSEM_1BYTE, INST_TCLOO_NS, 1, 1},
|
||||
{"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1},
|
||||
{"tryCvtToBoolean", ASSEM_1BYTE, INST_TRY_CVT_TO_BOOLEAN,1, 2},
|
||||
{"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1},
|
||||
{"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1},
|
||||
{"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0},
|
||||
@@ -514,7 +519,8 @@ static const unsigned char NonThrowingByteCodes[] = {
|
||||
INST_RESOLVE_COMMAND, /* 154 */
|
||||
INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */
|
||||
INST_CONCAT_STK, /* 169 */
|
||||
INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE /* 170-172 */
|
||||
INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE, /* 170-172 */
|
||||
INST_NUM_TYPE /* 180 */
|
||||
};
|
||||
|
||||
/*
|
||||
|
||||
+38
-24
@@ -259,7 +259,7 @@ static const CmdInfo builtInCmds[] = {
|
||||
{"variable", Tcl_VariableObjCmd, TclCompileVariableCmd, NULL, CMD_IS_SAFE},
|
||||
{"while", Tcl_WhileObjCmd, TclCompileWhileCmd, TclNRWhileObjCmd, CMD_IS_SAFE},
|
||||
{"yield", NULL, TclCompileYieldCmd, TclNRYieldObjCmd, CMD_IS_SAFE},
|
||||
{"yieldto", NULL, NULL, TclNRYieldToObjCmd, CMD_IS_SAFE},
|
||||
{"yieldto", NULL, TclCompileYieldToCmd, TclNRYieldToObjCmd, CMD_IS_SAFE},
|
||||
|
||||
/*
|
||||
* Commands in the OS-interface. Note that many of these are unsafe.
|
||||
@@ -2085,10 +2085,19 @@ Tcl_CreateCommand(
|
||||
*/
|
||||
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
oldRefPtr = cmdPtr->importRefPtr;
|
||||
cmdPtr->importRefPtr = NULL;
|
||||
cmdPtr->refCount++;
|
||||
if (cmdPtr->importRefPtr) {
|
||||
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
|
||||
}
|
||||
|
||||
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
|
||||
|
||||
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
|
||||
oldRefPtr = cmdPtr->importRefPtr;
|
||||
cmdPtr->importRefPtr = NULL;
|
||||
}
|
||||
TclCleanupCommandMacro(cmdPtr);
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
if (!isNew) {
|
||||
/*
|
||||
@@ -2272,10 +2281,19 @@ Tcl_CreateObjCommand(
|
||||
* intact.
|
||||
*/
|
||||
|
||||
oldRefPtr = cmdPtr->importRefPtr;
|
||||
cmdPtr->importRefPtr = NULL;
|
||||
cmdPtr->refCount++;
|
||||
if (cmdPtr->importRefPtr) {
|
||||
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
|
||||
}
|
||||
|
||||
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
|
||||
|
||||
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
|
||||
oldRefPtr = cmdPtr->importRefPtr;
|
||||
cmdPtr->importRefPtr = NULL;
|
||||
}
|
||||
TclCleanupCommandMacro(cmdPtr);
|
||||
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
|
||||
if (!isNew) {
|
||||
/*
|
||||
@@ -3117,12 +3135,13 @@ Tcl_DeleteCommandFromToken(
|
||||
* commands were created that refer back to this command. Delete these
|
||||
* imported commands now.
|
||||
*/
|
||||
|
||||
for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
|
||||
refPtr = nextRefPtr) {
|
||||
nextRefPtr = refPtr->nextPtr;
|
||||
importCmd = (Tcl_Command) refPtr->importedCmdPtr;
|
||||
Tcl_DeleteCommandFromToken(interp, importCmd);
|
||||
if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
|
||||
for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
|
||||
refPtr = nextRefPtr) {
|
||||
nextRefPtr = refPtr->nextPtr;
|
||||
importCmd = (Tcl_Command) refPtr->importedCmdPtr;
|
||||
Tcl_DeleteCommandFromToken(interp, importCmd);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -8416,8 +8435,7 @@ TclNRYieldToObjCmd(
|
||||
{
|
||||
CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
|
||||
Tcl_Obj *listPtr, *nsObjPtr;
|
||||
Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
|
||||
Tcl_Namespace *ns1Ptr;
|
||||
Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
|
||||
|
||||
if (objc < 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
|
||||
@@ -8431,11 +8449,13 @@ TclNRYieldToObjCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Add the tailcall in the caller env, then just yield.
|
||||
*
|
||||
* This is essentially code from TclNRTailcallObjCmd
|
||||
*/
|
||||
if (((Namespace *) nsPtr)->flags & NS_DYING) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"yieldto called in deleted namespace", -1));
|
||||
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Add the tailcall in the caller env, then just yield.
|
||||
@@ -8444,15 +8464,9 @@ TclNRYieldToObjCmd(
|
||||
*/
|
||||
|
||||
listPtr = Tcl_NewListObj(objc, objv);
|
||||
|
||||
nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
|
||||
|| (nsPtr != ns1Ptr)) {
|
||||
Tcl_Panic("yieldto failed to find the proper namespace");
|
||||
}
|
||||
TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
|
||||
|
||||
|
||||
/*
|
||||
* Add the callback in the caller's env, then instruct TEBC to yield.
|
||||
*/
|
||||
|
||||
+33
-41
@@ -610,9 +610,7 @@ UpdateStringOfByteArray(
|
||||
*
|
||||
* This function appends an array of bytes to a byte array object. Note
|
||||
* that the object *must* be unshared, and the array of bytes *must not*
|
||||
* refer to the object being appended to. Also the caller must have
|
||||
* already checked that the final length of the bytearray after the
|
||||
* append operations is complete will not overflow the int range.
|
||||
* refer to the object being appended to.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
@@ -631,6 +629,7 @@ TclAppendBytesToByteArray(
|
||||
int len)
|
||||
{
|
||||
ByteArray *byteArrayPtr;
|
||||
int needed;
|
||||
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
|
||||
@@ -639,64 +638,57 @@ TclAppendBytesToByteArray(
|
||||
Tcl_Panic("%s must be called with definite number of bytes to append",
|
||||
"TclAppendBytesToByteArray");
|
||||
}
|
||||
if (len == 0) {
|
||||
/* Append zero bytes is a no-op. */
|
||||
return;
|
||||
}
|
||||
if (objPtr->typePtr != &tclByteArrayType) {
|
||||
SetByteArrayFromAny(NULL, objPtr);
|
||||
}
|
||||
byteArrayPtr = GET_BYTEARRAY(objPtr);
|
||||
|
||||
if (len > INT_MAX - byteArrayPtr->used) {
|
||||
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
|
||||
}
|
||||
|
||||
needed = byteArrayPtr->used + len;
|
||||
/*
|
||||
* If we need to, resize the allocated space in the byte array.
|
||||
*/
|
||||
|
||||
if (byteArrayPtr->used + len > byteArrayPtr->allocated) {
|
||||
unsigned int attempt, used = byteArrayPtr->used;
|
||||
ByteArray *tmpByteArrayPtr = NULL;
|
||||
if (needed > byteArrayPtr->allocated) {
|
||||
ByteArray *ptr = NULL;
|
||||
int attempt;
|
||||
|
||||
attempt = byteArrayPtr->allocated;
|
||||
if (attempt < 1) {
|
||||
/*
|
||||
* No allocated bytes, so must be none used too. We use this
|
||||
* method to calculate how many bytes to allocate because we can
|
||||
* end up with a zero-length buffer otherwise, when doubling can
|
||||
* cause trouble. [Bug 3067036]
|
||||
*/
|
||||
|
||||
attempt = len + 1;
|
||||
} else {
|
||||
do {
|
||||
attempt *= 2;
|
||||
} while (attempt < used+len);
|
||||
if (needed <= INT_MAX/2) {
|
||||
/* Try to allocate double the total space that is needed. */
|
||||
attempt = 2 * needed;
|
||||
ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
|
||||
}
|
||||
if (ptr == NULL) {
|
||||
/* Try to allocate double the increment that is needed (plus). */
|
||||
unsigned int limit = INT_MAX - needed;
|
||||
unsigned int extra = len + TCL_MIN_GROWTH;
|
||||
int growth = (int) ((extra > limit) ? limit : extra);
|
||||
|
||||
if (BYTEARRAY_SIZE(attempt) > BYTEARRAY_SIZE(used)) {
|
||||
tmpByteArrayPtr = attemptckrealloc(byteArrayPtr,
|
||||
BYTEARRAY_SIZE(attempt));
|
||||
attempt = needed + growth;
|
||||
ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
|
||||
}
|
||||
|
||||
if (tmpByteArrayPtr == NULL) {
|
||||
attempt = used + len;
|
||||
if (BYTEARRAY_SIZE(attempt) < BYTEARRAY_SIZE(used)) {
|
||||
Tcl_Panic("attempt to allocate a bigger buffer than we can handle");
|
||||
}
|
||||
tmpByteArrayPtr = ckrealloc(byteArrayPtr,
|
||||
BYTEARRAY_SIZE(attempt));
|
||||
if (ptr == NULL) {
|
||||
/* Last chance: Try to allocate exactly what is needed. */
|
||||
attempt = needed;
|
||||
ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
|
||||
}
|
||||
|
||||
byteArrayPtr = tmpByteArrayPtr;
|
||||
byteArrayPtr = ptr;
|
||||
byteArrayPtr->allocated = attempt;
|
||||
byteArrayPtr->used = used;
|
||||
SET_BYTEARRAY(objPtr, byteArrayPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Do the append if there's any point.
|
||||
*/
|
||||
|
||||
if (len > 0) {
|
||||
if (bytes) {
|
||||
memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
|
||||
byteArrayPtr->used += len;
|
||||
TclInvalidateStringRep(objPtr);
|
||||
}
|
||||
byteArrayPtr->used += len;
|
||||
TclInvalidateStringRep(objPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+1
-1
@@ -19,7 +19,7 @@
|
||||
* Windows has mktime. The configurators do not check.
|
||||
*/
|
||||
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
#define HAVE_MKTIME 1
|
||||
#endif
|
||||
|
||||
|
||||
+1
-1
@@ -1590,7 +1590,7 @@ FileAttrIsOwnedCmd(
|
||||
* test for equivalence to the current user.
|
||||
*/
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__)
|
||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||
value = 1;
|
||||
#else
|
||||
value = (geteuid() == buf.st_uid);
|
||||
|
||||
+34
-34
@@ -18,6 +18,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
#include "tclRegexp.h"
|
||||
#include "tclStringTrim.h"
|
||||
|
||||
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
|
||||
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
|
||||
@@ -35,36 +36,35 @@ static int UniCharIsHexDigit(int character);
|
||||
/*
|
||||
* Default set of characters to trim in [string trim] and friends. This is a
|
||||
* UTF-8 literal string containing all Unicode space characters [TIP #413]
|
||||
*
|
||||
* Synch with tclCompCmdsSZ.c
|
||||
*/
|
||||
|
||||
#define DEFAULT_TRIM_SET \
|
||||
"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
|
||||
"\xc0\x80" /* nul (U+0000) */\
|
||||
"\xc2\x85" /* next line (U+0085) */\
|
||||
"\xc2\xa0" /* non-breaking space (U+00a0) */\
|
||||
"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
|
||||
"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
|
||||
"\xe2\x80\x80" /* en quad (U+2000) */\
|
||||
"\xe2\x80\x81" /* em quad (U+2001) */\
|
||||
"\xe2\x80\x82" /* en space (U+2002) */\
|
||||
"\xe2\x80\x83" /* em space (U+2003) */\
|
||||
"\xe2\x80\x84" /* three-per-em space (U+2004) */\
|
||||
"\xe2\x80\x85" /* four-per-em space (U+2005) */\
|
||||
"\xe2\x80\x86" /* six-per-em space (U+2006) */\
|
||||
"\xe2\x80\x87" /* figure space (U+2007) */\
|
||||
"\xe2\x80\x88" /* punctuation space (U+2008) */\
|
||||
"\xe2\x80\x89" /* thin space (U+2009) */\
|
||||
"\xe2\x80\x8a" /* hair space (U+200a) */\
|
||||
"\xe2\x80\x8b" /* zero width space (U+200b) */\
|
||||
"\xe2\x80\xa8" /* line separator (U+2028) */\
|
||||
"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
|
||||
"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
|
||||
"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
|
||||
"\xe2\x81\xa0" /* word joiner (U+2060) */\
|
||||
"\xe3\x80\x80" /* ideographic space (U+3000) */\
|
||||
const char tclDefaultTrimSet[] =
|
||||
"\x09\x0a\x0b\x0c\x0d " /* ASCII */
|
||||
"\xc0\x80" /* nul (U+0000) */
|
||||
"\xc2\x85" /* next line (U+0085) */
|
||||
"\xc2\xa0" /* non-breaking space (U+00a0) */
|
||||
"\xe1\x9a\x80" /* ogham space mark (U+1680) */
|
||||
"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
|
||||
"\xe2\x80\x80" /* en quad (U+2000) */
|
||||
"\xe2\x80\x81" /* em quad (U+2001) */
|
||||
"\xe2\x80\x82" /* en space (U+2002) */
|
||||
"\xe2\x80\x83" /* em space (U+2003) */
|
||||
"\xe2\x80\x84" /* three-per-em space (U+2004) */
|
||||
"\xe2\x80\x85" /* four-per-em space (U+2005) */
|
||||
"\xe2\x80\x86" /* six-per-em space (U+2006) */
|
||||
"\xe2\x80\x87" /* figure space (U+2007) */
|
||||
"\xe2\x80\x88" /* punctuation space (U+2008) */
|
||||
"\xe2\x80\x89" /* thin space (U+2009) */
|
||||
"\xe2\x80\x8a" /* hair space (U+200a) */
|
||||
"\xe2\x80\x8b" /* zero width space (U+200b) */
|
||||
"\xe2\x80\xa8" /* line separator (U+2028) */
|
||||
"\xe2\x80\xa9" /* paragraph separator (U+2029) */
|
||||
"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
|
||||
"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
|
||||
"\xe2\x81\xa0" /* word joiner (U+2060) */
|
||||
"\xe3\x80\x80" /* ideographic space (U+3000) */
|
||||
"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
|
||||
;
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -3191,8 +3191,8 @@ StringTrimCmd(
|
||||
if (objc == 3) {
|
||||
string2 = TclGetStringFromObj(objv[2], &length2);
|
||||
} else if (objc == 2) {
|
||||
string2 = DEFAULT_TRIM_SET;
|
||||
length2 = strlen(DEFAULT_TRIM_SET);
|
||||
string2 = tclDefaultTrimSet;
|
||||
length2 = strlen(tclDefaultTrimSet);
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
|
||||
return TCL_ERROR;
|
||||
@@ -3239,8 +3239,8 @@ StringTrimLCmd(
|
||||
if (objc == 3) {
|
||||
string2 = TclGetStringFromObj(objv[2], &length2);
|
||||
} else if (objc == 2) {
|
||||
string2 = DEFAULT_TRIM_SET;
|
||||
length2 = strlen(DEFAULT_TRIM_SET);
|
||||
string2 = tclDefaultTrimSet;
|
||||
length2 = strlen(tclDefaultTrimSet);
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
|
||||
return TCL_ERROR;
|
||||
@@ -3285,8 +3285,8 @@ StringTrimRCmd(
|
||||
if (objc == 3) {
|
||||
string2 = TclGetStringFromObj(objv[2], &length2);
|
||||
} else if (objc == 2) {
|
||||
string2 = DEFAULT_TRIM_SET;
|
||||
length2 = strlen(DEFAULT_TRIM_SET);
|
||||
string2 = tclDefaultTrimSet;
|
||||
length2 = strlen(tclDefaultTrimSet);
|
||||
} else {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
|
||||
return TCL_ERROR;
|
||||
@@ -3332,7 +3332,7 @@ TclInitStringCmd(
|
||||
{"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0},
|
||||
{"first", StringFirstCmd, TclCompileStringFirstCmd, NULL, NULL, 0},
|
||||
{"index", StringIndexCmd, TclCompileStringIndexCmd, NULL, NULL, 0},
|
||||
{"is", StringIsCmd, NULL, NULL, NULL, 0},
|
||||
{"is", StringIsCmd, TclCompileStringIsCmd, NULL, NULL, 0},
|
||||
{"last", StringLastCmd, TclCompileStringLastCmd, NULL, NULL, 0},
|
||||
{"length", StringLenCmd, TclCompileStringLenCmd, NULL, NULL, 0},
|
||||
{"map", StringMapCmd, TclCompileStringMapCmd, NULL, NULL, 0},
|
||||
|
||||
@@ -65,13 +65,6 @@ const AuxDataType tclDictUpdateInfoType = {
|
||||
FreeDictUpdateInfo, /* freeProc */
|
||||
PrintDictUpdateInfo /* printProc */
|
||||
};
|
||||
|
||||
/*
|
||||
* The definition of what whitespace is stripped when [concat]enating. Must be
|
||||
* kept in synch with tclUtil.c
|
||||
*/
|
||||
|
||||
#define CONCAT_WS " \f\v\r\t\n"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -285,7 +278,7 @@ TclCompileArraySetCmd(
|
||||
|
||||
if (isDataValid && !isDataEven) {
|
||||
PushStringLiteral(envPtr, "list must have an even number of elements");
|
||||
PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
|
||||
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
|
||||
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
|
||||
TclEmitInt4( 0, envPtr);
|
||||
goto done;
|
||||
@@ -380,7 +373,7 @@ TclCompileArraySetCmd(
|
||||
offsetFwd = CurrentOffset(envPtr);
|
||||
TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
|
||||
PushStringLiteral(envPtr, "list must have an even number of elements");
|
||||
PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
|
||||
PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
|
||||
TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr);
|
||||
TclEmitInt4( 0, envPtr);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
|
||||
@@ -1955,6 +1955,28 @@ TclCompileNamespaceCodeCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileNamespaceOriginCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
Tcl_Token *tokenPtr;
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
|
||||
if (parsePtr->numWords != 2) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, 1);
|
||||
TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileNamespaceQualifiersCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
@@ -3017,6 +3039,66 @@ IndexTailVarIfKnown(
|
||||
return localIndex;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
|
||||
*
|
||||
* Compilations of the TclOO utility commands [next] and [self].
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCompileObjectNextCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
|
||||
int i;
|
||||
|
||||
if (parsePtr->numWords > 255) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
for (i=0 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileObjectNextToCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
|
||||
int i;
|
||||
|
||||
if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
for (i=0 ; i<parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
TclEmitInstInt1( INST_TCLOO_NEXT_CLASS, i, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileObjectSelfCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
|
||||
+364
-36
@@ -17,6 +17,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
#include "tclCompile.h"
|
||||
#include "tclStringTrim.h"
|
||||
|
||||
/*
|
||||
* Prototypes for procedures defined later in this file:
|
||||
@@ -423,6 +424,284 @@ TclCompileStringIndexCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileStringIsCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
static const char *const isClasses[] = {
|
||||
"alnum", "alpha", "ascii", "control",
|
||||
"boolean", "digit", "double", "entier",
|
||||
"false", "graph", "integer", "list",
|
||||
"lower", "print", "punct", "space",
|
||||
"true", "upper", "wideinteger", "wordchar",
|
||||
"xdigit", NULL
|
||||
};
|
||||
enum isClasses {
|
||||
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
|
||||
STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
|
||||
STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
|
||||
STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
|
||||
STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
|
||||
STR_IS_XDIGIT
|
||||
};
|
||||
int t, range, allowEmpty = 0, end;
|
||||
InstStringClassType strClassType;
|
||||
Tcl_Obj *isClass;
|
||||
|
||||
if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
isClass = Tcl_NewObj();
|
||||
if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
|
||||
Tcl_DecrRefCount(isClass);
|
||||
return TCL_ERROR;
|
||||
} else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
|
||||
&t) != TCL_OK) {
|
||||
Tcl_DecrRefCount(isClass);
|
||||
TclCompileSyntaxError(interp, envPtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
Tcl_DecrRefCount(isClass);
|
||||
|
||||
#define GotLiteral(tokenPtr, word) \
|
||||
((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD && \
|
||||
(tokenPtr)[1].size > 1 && \
|
||||
(tokenPtr)[1].start[0] == word[0] && \
|
||||
strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
|
||||
|
||||
/*
|
||||
* Cannot handle the -failindex option at all, and that's the only legal
|
||||
* way to have more than 4 arguments.
|
||||
*/
|
||||
|
||||
if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
if (parsePtr->numWords == 3) {
|
||||
allowEmpty = 1;
|
||||
} else {
|
||||
if (!GotLiteral(tokenPtr, "-strict")) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
#undef GotLiteral
|
||||
|
||||
/*
|
||||
* Compile the code. There are several main classes of check here.
|
||||
* 1. Character classes
|
||||
* 2. Booleans
|
||||
* 3. Integers
|
||||
* 4. Floats
|
||||
* 5. Lists
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);
|
||||
|
||||
switch ((enum isClasses) t) {
|
||||
case STR_IS_ALNUM:
|
||||
strClassType = STR_CLASS_ALNUM;
|
||||
goto compileStrClass;
|
||||
case STR_IS_ALPHA:
|
||||
strClassType = STR_CLASS_ALPHA;
|
||||
goto compileStrClass;
|
||||
case STR_IS_ASCII:
|
||||
strClassType = STR_CLASS_ASCII;
|
||||
goto compileStrClass;
|
||||
case STR_IS_CONTROL:
|
||||
strClassType = STR_CLASS_CONTROL;
|
||||
goto compileStrClass;
|
||||
case STR_IS_DIGIT:
|
||||
strClassType = STR_CLASS_DIGIT;
|
||||
goto compileStrClass;
|
||||
case STR_IS_GRAPH:
|
||||
strClassType = STR_CLASS_GRAPH;
|
||||
goto compileStrClass;
|
||||
case STR_IS_LOWER:
|
||||
strClassType = STR_CLASS_LOWER;
|
||||
goto compileStrClass;
|
||||
case STR_IS_PRINT:
|
||||
strClassType = STR_CLASS_PRINT;
|
||||
goto compileStrClass;
|
||||
case STR_IS_PUNCT:
|
||||
strClassType = STR_CLASS_PUNCT;
|
||||
goto compileStrClass;
|
||||
case STR_IS_SPACE:
|
||||
strClassType = STR_CLASS_SPACE;
|
||||
goto compileStrClass;
|
||||
case STR_IS_UPPER:
|
||||
strClassType = STR_CLASS_UPPER;
|
||||
goto compileStrClass;
|
||||
case STR_IS_WORD:
|
||||
strClassType = STR_CLASS_WORD;
|
||||
goto compileStrClass;
|
||||
case STR_IS_XDIGIT:
|
||||
strClassType = STR_CLASS_XDIGIT;
|
||||
compileStrClass:
|
||||
if (allowEmpty) {
|
||||
OP1( STR_CLASS, strClassType);
|
||||
} else {
|
||||
int over, over2;
|
||||
|
||||
OP( DUP);
|
||||
OP1( STR_CLASS, strClassType);
|
||||
JUMP1( JUMP_TRUE, over);
|
||||
OP( POP);
|
||||
PUSH( "0");
|
||||
JUMP1( JUMP, over2);
|
||||
FIXJUMP1(over);
|
||||
PUSH( "");
|
||||
OP( STR_NEQ);
|
||||
FIXJUMP1(over2);
|
||||
}
|
||||
return TCL_OK;
|
||||
|
||||
case STR_IS_BOOL:
|
||||
case STR_IS_FALSE:
|
||||
case STR_IS_TRUE:
|
||||
OP( TRY_CVT_TO_BOOLEAN);
|
||||
switch (t) {
|
||||
int over, over2;
|
||||
|
||||
case STR_IS_BOOL:
|
||||
if (allowEmpty) {
|
||||
JUMP1( JUMP_TRUE, over);
|
||||
PUSH( "");
|
||||
OP( STR_EQ);
|
||||
JUMP1( JUMP, over2);
|
||||
FIXJUMP1(over);
|
||||
OP( POP);
|
||||
PUSH( "1");
|
||||
FIXJUMP1(over2);
|
||||
} else {
|
||||
OP4( REVERSE, 2);
|
||||
OP( POP);
|
||||
}
|
||||
return TCL_OK;
|
||||
case STR_IS_TRUE:
|
||||
JUMP1( JUMP_TRUE, over);
|
||||
if (allowEmpty) {
|
||||
PUSH( "");
|
||||
OP( STR_EQ);
|
||||
} else {
|
||||
OP( POP);
|
||||
PUSH( "0");
|
||||
}
|
||||
FIXJUMP1( over);
|
||||
OP( LNOT);
|
||||
OP( LNOT);
|
||||
return TCL_OK;
|
||||
case STR_IS_FALSE:
|
||||
JUMP1( JUMP_TRUE, over);
|
||||
if (allowEmpty) {
|
||||
PUSH( "");
|
||||
OP( STR_NEQ);
|
||||
} else {
|
||||
OP( POP);
|
||||
PUSH( "1");
|
||||
}
|
||||
FIXJUMP1( over);
|
||||
OP( LNOT);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
case STR_IS_DOUBLE: {
|
||||
int satisfied, isEmpty;
|
||||
|
||||
if (allowEmpty) {
|
||||
OP( DUP);
|
||||
PUSH( "");
|
||||
OP( STR_EQ);
|
||||
JUMP1( JUMP_TRUE, isEmpty);
|
||||
OP( NUM_TYPE);
|
||||
JUMP1( JUMP_TRUE, satisfied);
|
||||
PUSH( "0");
|
||||
JUMP1( JUMP, end);
|
||||
FIXJUMP1( isEmpty);
|
||||
OP( POP);
|
||||
FIXJUMP1( satisfied);
|
||||
} else {
|
||||
OP( NUM_TYPE);
|
||||
JUMP1( JUMP_TRUE, satisfied);
|
||||
PUSH( "0");
|
||||
JUMP1( JUMP, end);
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
FIXJUMP1( satisfied);
|
||||
}
|
||||
PUSH( "1");
|
||||
FIXJUMP1( end);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
case STR_IS_INT:
|
||||
case STR_IS_WIDE:
|
||||
case STR_IS_ENTIER:
|
||||
if (allowEmpty) {
|
||||
int testNumType;
|
||||
|
||||
OP( DUP);
|
||||
OP( NUM_TYPE);
|
||||
OP( DUP);
|
||||
JUMP1( JUMP_TRUE, testNumType);
|
||||
OP( POP);
|
||||
PUSH( "");
|
||||
OP( STR_EQ);
|
||||
JUMP1( JUMP, end);
|
||||
TclAdjustStackDepth(1, envPtr);
|
||||
FIXJUMP1( testNumType);
|
||||
OP4( REVERSE, 2);
|
||||
OP( POP);
|
||||
} else {
|
||||
OP( NUM_TYPE);
|
||||
OP( DUP);
|
||||
JUMP1( JUMP_FALSE, end);
|
||||
}
|
||||
|
||||
switch (t) {
|
||||
case STR_IS_INT:
|
||||
PUSH( "1");
|
||||
OP( EQ);
|
||||
break;
|
||||
case STR_IS_WIDE:
|
||||
PUSH( "2");
|
||||
OP( LE);
|
||||
break;
|
||||
case STR_IS_ENTIER:
|
||||
PUSH( "3");
|
||||
OP( LE);
|
||||
break;
|
||||
}
|
||||
FIXJUMP1( end);
|
||||
return TCL_OK;
|
||||
|
||||
case STR_IS_LIST:
|
||||
range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
|
||||
OP4( BEGIN_CATCH4, range);
|
||||
ExceptionRangeStarts(envPtr, range);
|
||||
OP( DUP);
|
||||
OP( LIST_LENGTH);
|
||||
OP( POP);
|
||||
ExceptionRangeEnds(envPtr, range);
|
||||
ExceptionRangeTarget(envPtr, range, catchOffset);
|
||||
OP( POP);
|
||||
OP( PUSH_RETURN_CODE);
|
||||
OP( END_CATCH);
|
||||
OP( LNOT);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
|
||||
}
|
||||
|
||||
int
|
||||
TclCompileStringMatchCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
@@ -700,8 +979,8 @@ TclCompileStringReplaceCmd(
|
||||
|
||||
/*
|
||||
* We handle these replacements specially: first character (where
|
||||
* idx1=idx2=0) and suffixes (where idx1=idx2=INDEX_END). Anything else
|
||||
* and the semantics get rather screwy.
|
||||
* idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything
|
||||
* else and the semantics get rather screwy.
|
||||
*/
|
||||
|
||||
if (idx1 == 0 && idx2 == 0) {
|
||||
@@ -787,37 +1066,6 @@ TclCompileStringReplaceCmd(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Synch with tclCmdMZ.c
|
||||
*/
|
||||
|
||||
#define DEFAULT_TRIM_SET \
|
||||
"\x09\x0a\x0b\x0c\x0d " /* ASCII */\
|
||||
"\xc0\x80" /* nul (U+0000) */\
|
||||
"\xc2\x85" /* next line (U+0085) */\
|
||||
"\xc2\xa0" /* non-breaking space (U+00a0) */\
|
||||
"\xe1\x9a\x80" /* ogham space mark (U+1680) */ \
|
||||
"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\
|
||||
"\xe2\x80\x80" /* en quad (U+2000) */\
|
||||
"\xe2\x80\x81" /* em quad (U+2001) */\
|
||||
"\xe2\x80\x82" /* en space (U+2002) */\
|
||||
"\xe2\x80\x83" /* em space (U+2003) */\
|
||||
"\xe2\x80\x84" /* three-per-em space (U+2004) */\
|
||||
"\xe2\x80\x85" /* four-per-em space (U+2005) */\
|
||||
"\xe2\x80\x86" /* six-per-em space (U+2006) */\
|
||||
"\xe2\x80\x87" /* figure space (U+2007) */\
|
||||
"\xe2\x80\x88" /* punctuation space (U+2008) */\
|
||||
"\xe2\x80\x89" /* thin space (U+2009) */\
|
||||
"\xe2\x80\x8a" /* hair space (U+200a) */\
|
||||
"\xe2\x80\x8b" /* zero width space (U+200b) */\
|
||||
"\xe2\x80\xa8" /* line separator (U+2028) */\
|
||||
"\xe2\x80\xa9" /* paragraph separator (U+2029) */\
|
||||
"\xe2\x80\xaf" /* narrow no-break space (U+202f) */\
|
||||
"\xe2\x81\x9f" /* medium mathematical space (U+205f) */\
|
||||
"\xe2\x81\xa0" /* word joiner (U+2060) */\
|
||||
"\xe3\x80\x80" /* ideographic space (U+3000) */\
|
||||
"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
|
||||
|
||||
int
|
||||
TclCompileStringTrimLCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
@@ -840,7 +1088,7 @@ TclCompileStringTrimLCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
} else {
|
||||
PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
|
||||
PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
|
||||
}
|
||||
OP( STR_TRIM_LEFT);
|
||||
return TCL_OK;
|
||||
@@ -868,7 +1116,7 @@ TclCompileStringTrimRCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
} else {
|
||||
PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
|
||||
PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
|
||||
}
|
||||
OP( STR_TRIM_RIGHT);
|
||||
return TCL_OK;
|
||||
@@ -896,7 +1144,7 @@ TclCompileStringTrimCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, 2);
|
||||
} else {
|
||||
PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET));
|
||||
PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
|
||||
}
|
||||
OP( STR_TRIM);
|
||||
return TCL_OK;
|
||||
@@ -968,6 +1216,41 @@ TclCompileStringToTitleCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Support definitions for the [string is] compilation.
|
||||
*/
|
||||
|
||||
static int
|
||||
UniCharIsAscii(
|
||||
int character)
|
||||
{
|
||||
return (character >= 0) && (character < 0x80);
|
||||
}
|
||||
|
||||
static int
|
||||
UniCharIsHexDigit(
|
||||
int character)
|
||||
{
|
||||
return (character >= 0) && (character < 0x80) && isxdigit(character);
|
||||
}
|
||||
|
||||
StringClassDesc const tclStringClassTable[] = {
|
||||
{"alnum", Tcl_UniCharIsAlnum},
|
||||
{"alpha", Tcl_UniCharIsAlpha},
|
||||
{"ascii", UniCharIsAscii},
|
||||
{"control", Tcl_UniCharIsControl},
|
||||
{"digit", Tcl_UniCharIsDigit},
|
||||
{"graph", Tcl_UniCharIsGraph},
|
||||
{"lower", Tcl_UniCharIsLower},
|
||||
{"print", Tcl_UniCharIsPrint},
|
||||
{"punct", Tcl_UniCharIsPunct},
|
||||
{"space", Tcl_UniCharIsSpace},
|
||||
{"upper", Tcl_UniCharIsUpper},
|
||||
{"word", Tcl_UniCharIsWordChar},
|
||||
{"xdigit", UniCharIsHexDigit},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3474,6 +3757,51 @@ TclCompileYieldCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclCompileYieldToCmd --
|
||||
*
|
||||
* Procedure called to compile the "yieldto" command.
|
||||
*
|
||||
* Results:
|
||||
* Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
|
||||
* evaluation to runtime.
|
||||
*
|
||||
* Side effects:
|
||||
* Instructions are added to envPtr to execute the "yieldto" command at
|
||||
* runtime.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclCompileYieldToCmd(
|
||||
Tcl_Interp *interp, /* Used for error reporting. */
|
||||
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
|
||||
* created by Tcl_ParseCommand. */
|
||||
Command *cmdPtr, /* Points to defintion of command being
|
||||
* compiled. */
|
||||
CompileEnv *envPtr) /* Holds resulting instructions. */
|
||||
{
|
||||
DefineLineInformation; /* TIP #280 */
|
||||
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
|
||||
int i;
|
||||
|
||||
if (parsePtr->numWords < 2) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
OP( NS_CURRENT);
|
||||
for (i = 1 ; i < parsePtr->numWords ; i++) {
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
}
|
||||
OP4( LIST, i);
|
||||
OP( YIELD_TO_INVOKE);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+70
-8
@@ -493,6 +493,7 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
* qualified version, or produces the empty string if no such command
|
||||
* exists. Never generates errors.
|
||||
* Stack: ... cmdName => ... fullCmdName */
|
||||
|
||||
{"tclooSelf", 1, +1, 0, {OPERAND_NONE}},
|
||||
/* Push the identity of the current TclOO object (i.e., the name of
|
||||
* its current public access command) on the stack. */
|
||||
@@ -594,23 +595,61 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
* is number of values to concatenate.
|
||||
* Operation: push concat(stk1 stk2 ... stktop) */
|
||||
|
||||
{"strUpper", 1, 0, 0, {OPERAND_NONE}},
|
||||
{"strcaseUpper", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* [string toupper] core: converts whole string to upper case using
|
||||
* the default (extended "C" locale) rules.
|
||||
* Stack: ... string => ... newString */
|
||||
{"strLower", 1, 0, 0, {OPERAND_NONE}},
|
||||
{"strcaseLower", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* [string tolower] core: converts whole string to upper case using
|
||||
* the default (extended "C" locale) rules.
|
||||
* Stack: ... string => ... newString */
|
||||
{"strTitle", 1, 0, 0, {OPERAND_NONE}},
|
||||
{"strcaseTitle", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* [string totitle] core: converts whole string to upper case using
|
||||
* the default (extended "C" locale) rules.
|
||||
* Stack: ... string => ... newString */
|
||||
{"strReplace", 1, -3, 0, {OPERAND_NONE}},
|
||||
{"strreplace", 1, -3, 0, {OPERAND_NONE}},
|
||||
/* [string replace] core: replaces a non-empty range of one string
|
||||
* with the contents of another.
|
||||
* Stack: ... string fromIdx toIdx replacement => ... newString */
|
||||
|
||||
{"originCmd", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* Reports which command was the origin (via namespace import chain)
|
||||
* of the command named on the top of the stack.
|
||||
* Stack: ... cmdName => ... fullOriginalCmdName */
|
||||
|
||||
{"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}},
|
||||
/* Call the next item on the TclOO call chain, passing opnd arguments
|
||||
* (min 1, max 255, *includes* "next"). The result of the invoked
|
||||
* method implementation will be pushed on the stack in place of the
|
||||
* arguments (similar to invokeStk).
|
||||
* Stack: ... "next" arg2 arg3 -- argN => ... result */
|
||||
{"tclooNextClass", 2, INT_MIN, 1, {OPERAND_UINT1}},
|
||||
/* Call the following item on the TclOO call chain defined by class
|
||||
* className, passing opnd arguments (min 2, max 255, *includes*
|
||||
* "nextto" and the class name). The result of the invoked method
|
||||
* implementation will be pushed on the stack in place of the
|
||||
* arguments (similar to invokeStk).
|
||||
* Stack: ... "nextto" className arg3 arg4 -- argN => ... result */
|
||||
|
||||
{"yieldToInvoke", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* Makes the current coroutine yield the value at the top of the
|
||||
* stack, invoking the given command/args with resolution in the given
|
||||
* namespace (all packed into a list), and places the list of values
|
||||
* that are the response back on top of the stack when it resumes.
|
||||
* Stack: ... [list ns cmd arg1 ... argN] => ... resumeList */
|
||||
|
||||
{"numericType", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* Pushes the numeric type code of the word at the top of the stack.
|
||||
* Stack: ... value => ... typeCode */
|
||||
{"tryCvtToBoolean", 1, +1, 0, {OPERAND_NONE}},
|
||||
/* Try converting stktop to boolean if possible. No errors.
|
||||
* Stack: ... value => ... value isStrictBool */
|
||||
{"strclass", 2, 0, 1, {OPERAND_SCLS1}},
|
||||
/* See if all the characters of the given string are a member of the
|
||||
* specified (by opnd) character class. Note that an empty string will
|
||||
* satisfy the class check (standard definition of "all").
|
||||
* Stack: ... stringValue => ... boolean */
|
||||
|
||||
{NULL, 0, 0, 0, {OPERAND_NONE}}
|
||||
};
|
||||
|
||||
@@ -5058,6 +5097,11 @@ FormatInstruction(
|
||||
}
|
||||
Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
|
||||
break;
|
||||
case OPERAND_SCLS1:
|
||||
opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
|
||||
Tcl_AppendPrintfToObj(bufferObj, "%s ",
|
||||
tclStringClassTable[opnd].name);
|
||||
break;
|
||||
case OPERAND_NONE:
|
||||
default:
|
||||
break;
|
||||
@@ -5274,7 +5318,7 @@ PrintSourceToObj(
|
||||
int maxChars) /* Maximum number of chars to print. */
|
||||
{
|
||||
register const char *p;
|
||||
register int i = 0;
|
||||
register int i = 0, len;
|
||||
|
||||
if (stringPtr == NULL) {
|
||||
Tcl_AppendToObj(appendObj, "\"\"", -1);
|
||||
@@ -5283,32 +5327,50 @@ PrintSourceToObj(
|
||||
|
||||
Tcl_AppendToObj(appendObj, "\"", -1);
|
||||
p = stringPtr;
|
||||
for (; (*p != '\0') && (i < maxChars); p++, i++) {
|
||||
switch (*p) {
|
||||
for (; (*p != '\0') && (i < maxChars); p+=len) {
|
||||
Tcl_UniChar ch;
|
||||
|
||||
len = TclUtfToUniChar(p, &ch);
|
||||
switch (ch) {
|
||||
case '"':
|
||||
Tcl_AppendToObj(appendObj, "\\\"", -1);
|
||||
i += 2;
|
||||
continue;
|
||||
case '\f':
|
||||
Tcl_AppendToObj(appendObj, "\\f", -1);
|
||||
i += 2;
|
||||
continue;
|
||||
case '\n':
|
||||
Tcl_AppendToObj(appendObj, "\\n", -1);
|
||||
i += 2;
|
||||
continue;
|
||||
case '\r':
|
||||
Tcl_AppendToObj(appendObj, "\\r", -1);
|
||||
i += 2;
|
||||
continue;
|
||||
case '\t':
|
||||
Tcl_AppendToObj(appendObj, "\\t", -1);
|
||||
i += 2;
|
||||
continue;
|
||||
case '\v':
|
||||
Tcl_AppendToObj(appendObj, "\\v", -1);
|
||||
i += 2;
|
||||
continue;
|
||||
default:
|
||||
Tcl_AppendPrintfToObj(appendObj, "%c", *p);
|
||||
if (ch < 0x20 || ch >= 0x7f) {
|
||||
Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
|
||||
i += 6;
|
||||
} else {
|
||||
Tcl_AppendPrintfToObj(appendObj, "%c", ch);
|
||||
i++;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
}
|
||||
Tcl_AppendToObj(appendObj, "\"", -1);
|
||||
if (*p != '\0') {
|
||||
Tcl_AppendToObj(appendObj, "...", -1);
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
|
||||
+50
-2
@@ -751,6 +751,8 @@ typedef struct ByteCode {
|
||||
#define INST_INFO_LEVEL_NUM 152
|
||||
#define INST_INFO_LEVEL_ARGS 153
|
||||
#define INST_RESOLVE_COMMAND 154
|
||||
|
||||
/* For compilation relating to TclOO */
|
||||
#define INST_TCLOO_SELF 155
|
||||
#define INST_TCLOO_CLASS 156
|
||||
#define INST_TCLOO_NS 157
|
||||
@@ -786,8 +788,19 @@ typedef struct ByteCode {
|
||||
#define INST_STR_TITLE 176
|
||||
#define INST_STR_REPLACE 177
|
||||
|
||||
#define INST_ORIGIN_COMMAND 178
|
||||
|
||||
#define INST_TCLOO_NEXT 179
|
||||
#define INST_TCLOO_NEXT_CLASS 180
|
||||
|
||||
#define INST_YIELD_TO_INVOKE 181
|
||||
|
||||
#define INST_NUM_TYPE 182
|
||||
#define INST_TRY_CVT_TO_BOOLEAN 183
|
||||
#define INST_STR_CLASS 184
|
||||
|
||||
/* The last opcode */
|
||||
#define LAST_INST_OPCODE 177
|
||||
#define LAST_INST_OPCODE 184
|
||||
|
||||
/*
|
||||
* Table describing the Tcl bytecode instructions: their name (for displaying
|
||||
@@ -812,8 +825,9 @@ typedef enum InstOperandType {
|
||||
* variable table. */
|
||||
OPERAND_LVT4, /* Four byte unsigned index into the local
|
||||
* variable table. */
|
||||
OPERAND_AUX4 /* Four byte unsigned index into the aux data
|
||||
OPERAND_AUX4, /* Four byte unsigned index into the aux data
|
||||
* table. */
|
||||
OPERAND_SCLS1 /* Index into tclStringClassTable. */
|
||||
} InstOperandType;
|
||||
|
||||
typedef struct InstructionDesc {
|
||||
@@ -831,6 +845,40 @@ typedef struct InstructionDesc {
|
||||
|
||||
MODULE_SCOPE InstructionDesc const tclInstructionTable[];
|
||||
|
||||
/*
|
||||
* Constants used by INST_STRING_CLASS to indicate character classes. These
|
||||
* correspond closely by name with what [string is] can support, but there is
|
||||
* no requirement to keep the values the same.
|
||||
*/
|
||||
|
||||
typedef enum InstStringClassType {
|
||||
STR_CLASS_ALNUM, /* Unicode alphabet or digit characters. */
|
||||
STR_CLASS_ALPHA, /* Unicode alphabet characters. */
|
||||
STR_CLASS_ASCII, /* Characters in range U+000000..U+00007F. */
|
||||
STR_CLASS_CONTROL, /* Unicode control characters. */
|
||||
STR_CLASS_DIGIT, /* Unicode digit characters. */
|
||||
STR_CLASS_GRAPH, /* Unicode printing characters, excluding
|
||||
* space. */
|
||||
STR_CLASS_LOWER, /* Unicode lower-case alphabet characters. */
|
||||
STR_CLASS_PRINT, /* Unicode printing characters, including
|
||||
* spaces. */
|
||||
STR_CLASS_PUNCT, /* Unicode punctuation characters. */
|
||||
STR_CLASS_SPACE, /* Unicode space characters. */
|
||||
STR_CLASS_UPPER, /* Unicode upper-case alphabet characters. */
|
||||
STR_CLASS_WORD, /* Unicode word (alphabetic, digit, connector
|
||||
* punctuation) characters. */
|
||||
STR_CLASS_XDIGIT /* Characters that can be used as digits in
|
||||
* hexadecimal numbers ([0-9A-Fa-f]). */
|
||||
} InstStringClassType;
|
||||
|
||||
typedef struct StringClassDesc {
|
||||
const char *name; /* Name of the class. */
|
||||
int (*comparator)(int); /* Function to test if a single unicode
|
||||
* character is a member of the class. */
|
||||
} StringClassDesc;
|
||||
|
||||
MODULE_SCOPE StringClassDesc const tclStringClassTable[];
|
||||
|
||||
/*
|
||||
* Compilation of some Tcl constructs such as if commands and the logical or
|
||||
* (||) and logical and (&&) operators in expressions requires the generation
|
||||
|
||||
+12
-12
@@ -63,7 +63,7 @@ EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line);
|
||||
/* 8 */
|
||||
EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size,
|
||||
const char *file, int line);
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
/* 9 */
|
||||
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
|
||||
Tcl_FileProc *proc, ClientData clientData);
|
||||
@@ -73,7 +73,7 @@ EXTERN void Tcl_CreateFileHandler(int fd, int mask,
|
||||
EXTERN void Tcl_CreateFileHandler(int fd, int mask,
|
||||
Tcl_FileProc *proc, ClientData clientData);
|
||||
#endif /* MACOSX */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
/* 10 */
|
||||
EXTERN void Tcl_DeleteFileHandler(int fd);
|
||||
#endif /* UNIX */
|
||||
@@ -511,7 +511,7 @@ EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_GetNameOfExecutable(void);
|
||||
/* 166 */
|
||||
EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp);
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
/* 167 */
|
||||
EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp,
|
||||
const char *chanID, int forWriting,
|
||||
@@ -1835,19 +1835,19 @@ typedef struct TclStubs {
|
||||
char * (*tcl_DbCkalloc) (unsigned int size, const char *file, int line); /* 6 */
|
||||
void (*tcl_DbCkfree) (char *ptr, const char *file, int line); /* 7 */
|
||||
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 8 */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) /* WIN */
|
||||
#if defined(_WIN32) /* WIN */
|
||||
void (*reserved9)(void);
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
|
||||
#endif /* MACOSX */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
void (*tcl_DeleteFileHandler) (int fd); /* 10 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) /* WIN */
|
||||
#if defined(_WIN32) /* WIN */
|
||||
void (*reserved10)(void);
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
@@ -2009,10 +2009,10 @@ typedef struct TclStubs {
|
||||
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
|
||||
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
|
||||
Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) /* WIN */
|
||||
#if defined(_WIN32) /* WIN */
|
||||
void (*reserved167)(void);
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
@@ -2513,7 +2513,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_DbCkfree) /* 7 */
|
||||
#define Tcl_DbCkrealloc \
|
||||
(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#define Tcl_CreateFileHandler \
|
||||
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
|
||||
#endif /* UNIX */
|
||||
@@ -2521,7 +2521,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_CreateFileHandler \
|
||||
(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
|
||||
#endif /* MACOSX */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#define Tcl_DeleteFileHandler \
|
||||
(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
|
||||
#endif /* UNIX */
|
||||
@@ -2841,7 +2841,7 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
|
||||
#define Tcl_GetObjResult \
|
||||
(tclStubsPtr->tcl_GetObjResult) /* 166 */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#define Tcl_GetOpenFile \
|
||||
(tclStubsPtr->tcl_GetOpenFile) /* 167 */
|
||||
#endif /* UNIX */
|
||||
|
||||
@@ -182,6 +182,7 @@ TCL_DECLARE_MUTEX(encodingMutex)
|
||||
|
||||
static Tcl_Encoding defaultEncoding;
|
||||
static Tcl_Encoding systemEncoding;
|
||||
Tcl_Encoding tclIdentityEncoding;
|
||||
|
||||
/*
|
||||
* The following variable is used in the sparse matrix code for a
|
||||
@@ -567,7 +568,7 @@ TclInitEncodingSubsystem(void)
|
||||
type.freeProc = NULL;
|
||||
type.nullSize = 1;
|
||||
type.clientData = NULL;
|
||||
Tcl_CreateEncoding(&type);
|
||||
tclIdentityEncoding = Tcl_CreateEncoding(&type);
|
||||
|
||||
type.encodingName = "utf-8";
|
||||
type.toUtfProc = UtfExtToUtfIntProc;
|
||||
@@ -651,6 +652,7 @@ TclFinalizeEncodingSubsystem(void)
|
||||
Tcl_MutexLock(&encodingMutex);
|
||||
encodingsInitialized = 0;
|
||||
FreeEncoding(systemEncoding);
|
||||
FreeEncoding(tclIdentityEncoding);
|
||||
|
||||
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
|
||||
while (hPtr != NULL) {
|
||||
|
||||
+2
-2
@@ -444,7 +444,7 @@ TclUnsetEnv(
|
||||
* that no = should be included, and Windows requires it.
|
||||
*/
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__)
|
||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||
string = ckalloc(length + 2);
|
||||
memcpy(string, name, (size_t) length);
|
||||
string[length] = '=';
|
||||
@@ -453,7 +453,7 @@ TclUnsetEnv(
|
||||
string = ckalloc(length + 1);
|
||||
memcpy(string, name, (size_t) length);
|
||||
string[length] = '\0';
|
||||
#endif /* WIN32 */
|
||||
#endif /* _WIN32 */
|
||||
|
||||
Tcl_UtfToExternalDString(NULL, string, -1, &envString);
|
||||
string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
|
||||
|
||||
+919
-462
File diff suppressed because it is too large
Load Diff
+1
-1
@@ -517,7 +517,7 @@ CopyRenameOneFile(
|
||||
* 16 bits and we get collisions. See bug #2015723.
|
||||
*/
|
||||
|
||||
#if !defined(WIN32) && !defined(__CYGWIN__)
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__)
|
||||
if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
|
||||
if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
|
||||
(sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
|
||||
|
||||
+174
-769
File diff suppressed because it is too large
Load Diff
+4
-4
@@ -19,7 +19,7 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
# include "tclWinInt.h"
|
||||
#endif
|
||||
#include "tclFileSystem.h"
|
||||
@@ -792,7 +792,7 @@ TclFinalizeFilesystem(void)
|
||||
* filesystem is likely to fail.
|
||||
*/
|
||||
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
TclWinEncodingsCleanup();
|
||||
#endif
|
||||
}
|
||||
@@ -819,7 +819,7 @@ TclResetFilesystem(void)
|
||||
filesystemList = &nativeFilesystemRecord;
|
||||
theFilesystemEpoch++;
|
||||
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
/*
|
||||
* Cleans up the win32 API filesystem proc lookup table. This must happen
|
||||
* very late in finalization so that deleting of copied dlls can occur.
|
||||
@@ -3255,7 +3255,7 @@ Tcl_LoadFile(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
#ifndef __WIN32__
|
||||
#ifndef _WIN32
|
||||
/*
|
||||
* Do we need to set appropriate permissions on the file? This may be
|
||||
* required on some systems. On Unix we could loop over the file
|
||||
|
||||
@@ -1686,6 +1686,7 @@ typedef struct Command {
|
||||
#define CMD_TRACE_ACTIVE 0x2
|
||||
#define CMD_HAS_EXEC_TRACES 0x4
|
||||
#define CMD_COMPILES_EXPANDED 0x8
|
||||
#define CMD_REDEF_IN_PROGRESS 0x10
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -2639,6 +2640,8 @@ MODULE_SCOPE char *tclMemDumpFileName;
|
||||
MODULE_SCOPE TclPlatformType tclPlatform;
|
||||
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
|
||||
|
||||
MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
|
||||
|
||||
/*
|
||||
* TIP #233 (Virtualized Time)
|
||||
* Data for the time hooks, if any.
|
||||
@@ -3571,6 +3574,9 @@ MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileNamespaceOriginCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
@@ -3586,6 +3592,12 @@ MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileObjectNextCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileObjectNextToCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
@@ -3613,6 +3625,9 @@ MODULE_SCOPE int TclCompileStringFirstCmd(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclCompileStringIndexCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileStringIsCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileStringLastCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
@@ -3679,6 +3694,9 @@ MODULE_SCOPE int TclCompileWhileCmd(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclCompileYieldCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileYieldToCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCompileBasic0ArgCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
|
||||
@@ -13,7 +13,7 @@
|
||||
#ifndef _TCLINTPLATDECLS
|
||||
#define _TCLINTPLATDECLS
|
||||
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
# define Tcl_DirEntry void
|
||||
# define DIR void
|
||||
#endif
|
||||
@@ -45,7 +45,7 @@ extern "C" {
|
||||
* Exported function declarations:
|
||||
*/
|
||||
|
||||
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
/* 0 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
@@ -104,7 +104,7 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
|
||||
Tcl_Obj *resultingNameObj);
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN void TclWinConvertError(DWORD errCode);
|
||||
/* 1 */
|
||||
@@ -258,7 +258,7 @@ typedef struct TclIntPlatStubs {
|
||||
int magic;
|
||||
void *hooks;
|
||||
|
||||
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 1 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
|
||||
@@ -291,7 +291,7 @@ typedef struct TclIntPlatStubs {
|
||||
int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
void (*tclWinConvertError) (DWORD errCode); /* 0 */
|
||||
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
|
||||
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
|
||||
@@ -371,7 +371,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
|
||||
#define TclpCloseFile \
|
||||
@@ -420,7 +420,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
#define TclWinConvertError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
|
||||
#define TclWinConvertWSAError \
|
||||
@@ -550,7 +550,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#undef TclpInetNtoa
|
||||
#define TclpInetNtoa inet_ntoa
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__)
|
||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||
# undef TclWinNToHS
|
||||
# define TclWinNToHS ntohs
|
||||
#else
|
||||
|
||||
+2
-2
@@ -830,7 +830,7 @@ Tcl_UnloadObjCmd(
|
||||
* Unload the shared library from the application memory...
|
||||
*/
|
||||
|
||||
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
|
||||
#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
|
||||
/*
|
||||
* Some Unix dlls are poorly behaved - registering things like atexit
|
||||
* calls that can't be unregistered. If you unload such dlls, you get
|
||||
@@ -1151,7 +1151,7 @@ TclFinalizeLoad(void)
|
||||
pkgPtr = firstPackagePtr;
|
||||
firstPackagePtr = pkgPtr->nextPtr;
|
||||
|
||||
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
|
||||
#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
|
||||
/*
|
||||
* Some Unix dlls are poorly behaved - registering things like atexit
|
||||
* calls that can't be unregistered. If you unload such dlls, you get
|
||||
|
||||
+1
-1
@@ -47,7 +47,7 @@
|
||||
* we have to translate that to strcmp here.
|
||||
*/
|
||||
|
||||
#ifndef __WIN32__
|
||||
#ifndef _WIN32
|
||||
# define TCHAR char
|
||||
# define TEXT(arg) arg
|
||||
# define _tcscmp strcmp
|
||||
|
||||
+1
-1
@@ -171,7 +171,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = {
|
||||
{"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
|
||||
{"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
|
||||
{"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0},
|
||||
{"origin", NamespaceOriginCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0},
|
||||
{"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
|
||||
{"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
|
||||
{"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
|
||||
|
||||
+6
-4
@@ -437,10 +437,12 @@ InitFoundation(
|
||||
* ensemble.
|
||||
*/
|
||||
|
||||
Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL,
|
||||
NULL);
|
||||
Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd,
|
||||
NULL, NULL);
|
||||
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
|
||||
NULL, TclOONextObjCmd, NULL, NULL);
|
||||
cmdPtr->compileProc = TclCompileObjectNextCmd;
|
||||
cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
|
||||
NULL, TclOONextToObjCmd, NULL, NULL);
|
||||
cmdPtr->compileProc = TclCompileObjectNextToCmd;
|
||||
cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
|
||||
TclOOSelfObjCmd, NULL, NULL);
|
||||
cmdPtr->compileProc = TclCompileObjectSelfCmd;
|
||||
|
||||
@@ -18,6 +18,7 @@ library tclOO
|
||||
|
||||
interface tclOO
|
||||
hooks tclOOInt
|
||||
scspec TCLAPI
|
||||
|
||||
declare 0 {
|
||||
Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
|
||||
|
||||
+25
-18
@@ -17,16 +17,11 @@
|
||||
#include "tclOOInt.h"
|
||||
|
||||
static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
|
||||
static int AfterNRDestructor(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int DecrRefsPostClassConstructor(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int FinalizeConstruction(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int FinalizeEval(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static int RestoreFrame(ClientData data[],
|
||||
Tcl_Interp *interp, int result);
|
||||
static Tcl_NRPostProc AfterNRDestructor;
|
||||
static Tcl_NRPostProc DecrRefsPostClassConstructor;
|
||||
static Tcl_NRPostProc FinalizeConstruction;
|
||||
static Tcl_NRPostProc FinalizeEval;
|
||||
static Tcl_NRPostProc NextRestoreFrame;
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -808,7 +803,7 @@ TclOONextObjCmd(
|
||||
* that this is like [uplevel 1] and not [eval].
|
||||
*/
|
||||
|
||||
TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL);
|
||||
TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
|
||||
iPtr->varFramePtr = framePtr->callerVarPtr;
|
||||
return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
|
||||
}
|
||||
@@ -826,6 +821,7 @@ TclOONextToObjCmd(
|
||||
CallContext *contextPtr;
|
||||
int i;
|
||||
Tcl_Object object;
|
||||
const char *methodType;
|
||||
|
||||
/*
|
||||
* Start with sanity checks on the calling context to make sure that we
|
||||
@@ -877,8 +873,8 @@ TclOONextToObjCmd(
|
||||
* context. Note that this is like [uplevel 1] and not [eval].
|
||||
*/
|
||||
|
||||
TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr,
|
||||
INT2PTR(contextPtr->index), NULL);
|
||||
TclNRAddCallback(interp, NextRestoreFrame, framePtr,
|
||||
contextPtr, INT2PTR(contextPtr->index), NULL);
|
||||
contextPtr->index = i-1;
|
||||
iPtr->varFramePtr = framePtr->callerVarPtr;
|
||||
return TclNRObjectContextInvokeNext(interp,
|
||||
@@ -891,24 +887,35 @@ TclOONextToObjCmd(
|
||||
* is on the chain but unreachable, or not on the chain at all.
|
||||
*/
|
||||
|
||||
if (contextPtr->callPtr->flags & CONSTRUCTOR) {
|
||||
methodType = "constructor";
|
||||
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
|
||||
methodType = "destructor";
|
||||
} else {
|
||||
methodType = "method";
|
||||
}
|
||||
|
||||
for (i=contextPtr->index ; i>=0 ; i--) {
|
||||
struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
|
||||
|
||||
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"method implementation by \"%s\" not reachable from here",
|
||||
TclGetString(objv[1])));
|
||||
"%s implementation by \"%s\" not reachable from here",
|
||||
methodType, TclGetString(objv[1])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"method has no non-filter implementation by \"%s\"",
|
||||
TclGetString(objv[1])));
|
||||
"%s has no non-filter implementation by \"%s\"",
|
||||
methodType, TclGetString(objv[1])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
static int
|
||||
RestoreFrame(
|
||||
NextRestoreFrame(
|
||||
ClientData data[],
|
||||
Tcl_Interp *interp,
|
||||
int result)
|
||||
|
||||
+38
-40
@@ -5,19 +5,19 @@
|
||||
#ifndef _TCLOODECLS
|
||||
#define _TCLOODECLS
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_tcl
|
||||
# define TCL_STORAGE_CLASS DLLEXPORT
|
||||
#else
|
||||
# ifdef USE_TCL_STUBS
|
||||
# undef USE_TCLOO_STUBS
|
||||
# define USE_TCLOO_STUBS
|
||||
# define TCL_STORAGE_CLASS
|
||||
#ifndef TCLAPI
|
||||
# ifdef BUILD_tcl
|
||||
# define TCLAPI extern DLLEXPORT
|
||||
# else
|
||||
# define TCL_STORAGE_CLASS DLLIMPORT
|
||||
# define TCLAPI extern DLLIMPORT
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#ifdef USE_TCL_STUBS
|
||||
# undef USE_TCLOO_STUBS
|
||||
# define USE_TCLOO_STUBS
|
||||
#endif
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
#ifdef __cplusplus
|
||||
@@ -29,92 +29,92 @@ extern "C" {
|
||||
*/
|
||||
|
||||
/* 0 */
|
||||
EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
|
||||
Tcl_Object sourceObject,
|
||||
const char *targetName,
|
||||
const char *targetNamespaceName);
|
||||
/* 1 */
|
||||
EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
|
||||
TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz);
|
||||
/* 2 */
|
||||
EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
|
||||
TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object);
|
||||
/* 3 */
|
||||
EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
|
||||
TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object);
|
||||
/* 4 */
|
||||
EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
/* 5 */
|
||||
EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
|
||||
TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object);
|
||||
/* 6 */
|
||||
EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
|
||||
TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method);
|
||||
/* 7 */
|
||||
EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
|
||||
TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method);
|
||||
/* 8 */
|
||||
EXTERN int Tcl_MethodIsPublic(Tcl_Method method);
|
||||
TCLAPI int Tcl_MethodIsPublic(Tcl_Method method);
|
||||
/* 9 */
|
||||
EXTERN int Tcl_MethodIsType(Tcl_Method method,
|
||||
TCLAPI int Tcl_MethodIsType(Tcl_Method method,
|
||||
const Tcl_MethodType *typePtr,
|
||||
ClientData *clientDataPtr);
|
||||
/* 10 */
|
||||
EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method);
|
||||
TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
|
||||
/* 11 */
|
||||
EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
|
||||
Tcl_Object object, Tcl_Obj *nameObj,
|
||||
int isPublic, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData);
|
||||
/* 12 */
|
||||
EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
|
||||
TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
|
||||
Tcl_Obj *nameObj, int isPublic,
|
||||
const Tcl_MethodType *typePtr,
|
||||
ClientData clientData);
|
||||
/* 13 */
|
||||
EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp,
|
||||
Tcl_Class cls, const char *nameStr,
|
||||
const char *nsNameStr, int objc,
|
||||
Tcl_Obj *const *objv, int skip);
|
||||
/* 14 */
|
||||
EXTERN int Tcl_ObjectDeleted(Tcl_Object object);
|
||||
TCLAPI int Tcl_ObjectDeleted(Tcl_Object object);
|
||||
/* 15 */
|
||||
EXTERN int Tcl_ObjectContextIsFiltering(
|
||||
TCLAPI int Tcl_ObjectContextIsFiltering(
|
||||
Tcl_ObjectContext context);
|
||||
/* 16 */
|
||||
EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
|
||||
TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context);
|
||||
/* 17 */
|
||||
EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
|
||||
TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context);
|
||||
/* 18 */
|
||||
EXTERN int Tcl_ObjectContextSkippedArgs(
|
||||
TCLAPI int Tcl_ObjectContextSkippedArgs(
|
||||
Tcl_ObjectContext context);
|
||||
/* 19 */
|
||||
EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
|
||||
TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz,
|
||||
const Tcl_ObjectMetadataType *typePtr);
|
||||
/* 20 */
|
||||
EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz,
|
||||
TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz,
|
||||
const Tcl_ObjectMetadataType *typePtr,
|
||||
ClientData metadata);
|
||||
/* 21 */
|
||||
EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
|
||||
TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object,
|
||||
const Tcl_ObjectMetadataType *typePtr);
|
||||
/* 22 */
|
||||
EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object,
|
||||
TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object,
|
||||
const Tcl_ObjectMetadataType *typePtr,
|
||||
ClientData metadata);
|
||||
/* 23 */
|
||||
EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
|
||||
TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
|
||||
Tcl_ObjectContext context, int objc,
|
||||
Tcl_Obj *const *objv, int skip);
|
||||
/* 24 */
|
||||
EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
|
||||
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
|
||||
Tcl_Object object);
|
||||
/* 25 */
|
||||
EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
|
||||
TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
|
||||
Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
|
||||
/* 26 */
|
||||
EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp,
|
||||
TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp,
|
||||
Tcl_Class clazz, Tcl_Method method);
|
||||
/* 27 */
|
||||
EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp,
|
||||
TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
|
||||
Tcl_Class clazz, Tcl_Method method);
|
||||
/* 28 */
|
||||
EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
|
||||
Tcl_Object object);
|
||||
|
||||
typedef struct {
|
||||
@@ -231,6 +231,4 @@ extern const TclOOStubs *tclOOStubsPtr;
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
#endif /* _TCLOODECLS */
|
||||
|
||||
+16
-29
@@ -5,17 +5,6 @@
|
||||
#ifndef _TCLOOINTDECLS
|
||||
#define _TCLOOINTDECLS
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_tcl
|
||||
# define TCL_STORAGE_CLASS DLLEXPORT
|
||||
#else
|
||||
# ifdef USE_TCL_STUBS
|
||||
# define TCL_STORAGE_CLASS
|
||||
# else
|
||||
# define TCL_STORAGE_CLASS DLLIMPORT
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
#ifdef __cplusplus
|
||||
@@ -27,46 +16,46 @@ extern "C" {
|
||||
*/
|
||||
|
||||
/* 0 */
|
||||
EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
|
||||
TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp);
|
||||
/* 1 */
|
||||
EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
|
||||
Object *oPtr, int flags, Tcl_Obj *nameObj,
|
||||
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
|
||||
const Tcl_MethodType *typePtr,
|
||||
ClientData clientData, Proc **procPtrPtr);
|
||||
/* 2 */
|
||||
EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp,
|
||||
Class *clsPtr, int flags, Tcl_Obj *nameObj,
|
||||
const char *namePtr, Tcl_Obj *argsObj,
|
||||
Tcl_Obj *bodyObj,
|
||||
const Tcl_MethodType *typePtr,
|
||||
ClientData clientData, Proc **procPtrPtr);
|
||||
/* 3 */
|
||||
EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
|
||||
TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp,
|
||||
Object *oPtr, int flags, Tcl_Obj *nameObj,
|
||||
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
|
||||
ProcedureMethod **pmPtrPtr);
|
||||
/* 4 */
|
||||
EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
|
||||
TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
|
||||
int flags, Tcl_Obj *nameObj,
|
||||
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
|
||||
ProcedureMethod **pmPtrPtr);
|
||||
/* 5 */
|
||||
EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
|
||||
TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
|
||||
int objc, Tcl_Obj *const *objv,
|
||||
int publicOnly, Class *startCls);
|
||||
/* 6 */
|
||||
EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr);
|
||||
TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr);
|
||||
/* 7 */
|
||||
EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp,
|
||||
TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp,
|
||||
Class *clsPtr, int isPublic,
|
||||
Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
|
||||
/* 8 */
|
||||
EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
|
||||
TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp,
|
||||
Object *oPtr, int isPublic, Tcl_Obj *nameObj,
|
||||
Tcl_Obj *prefixObj);
|
||||
/* 9 */
|
||||
EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
|
||||
Tcl_Object oPtr,
|
||||
TclOO_PreCallProc *preCallPtr,
|
||||
TclOO_PostCallProc *postCallPtr,
|
||||
@@ -75,7 +64,7 @@ EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
|
||||
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
|
||||
int flags, void **internalTokenPtr);
|
||||
/* 10 */
|
||||
EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
|
||||
TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
|
||||
Tcl_Class clsPtr,
|
||||
TclOO_PreCallProc *preCallPtr,
|
||||
TclOO_PostCallProc *postCallPtr,
|
||||
@@ -84,22 +73,22 @@ EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp,
|
||||
Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
|
||||
int flags, void **internalTokenPtr);
|
||||
/* 11 */
|
||||
EXTERN int TclOOInvokeObject(Tcl_Interp *interp,
|
||||
TCLAPI int TclOOInvokeObject(Tcl_Interp *interp,
|
||||
Tcl_Object object, Tcl_Class startCls,
|
||||
int publicPrivate, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
/* 12 */
|
||||
EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters,
|
||||
TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters,
|
||||
Tcl_Obj *const *filters);
|
||||
/* 13 */
|
||||
EXTERN void TclOOClassSetFilters(Tcl_Interp *interp,
|
||||
TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp,
|
||||
Class *classPtr, int numFilters,
|
||||
Tcl_Obj *const *filters);
|
||||
/* 14 */
|
||||
EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins,
|
||||
TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins,
|
||||
Class *const *mixins);
|
||||
/* 15 */
|
||||
EXTERN void TclOOClassSetMixins(Tcl_Interp *interp,
|
||||
TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp,
|
||||
Class *classPtr, int numMixins,
|
||||
Class *const *mixins);
|
||||
|
||||
@@ -174,6 +163,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr;
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
#endif /* _TCLOOINTDECLS */
|
||||
|
||||
@@ -512,7 +512,7 @@ TclFSGetPathType(
|
||||
|
||||
if (PATHFLAGS(pathPtr) == 0) {
|
||||
/* The path is not absolute... */
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
/* ... on Windows we must make another call to determine whether
|
||||
* it's relative or volumerelative [Bug 2571597]. */
|
||||
return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
|
||||
@@ -1956,7 +1956,7 @@ Tcl_FSGetNormalizedPath(
|
||||
/*
|
||||
* We have a refCount on the cwd.
|
||||
*/
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
} else if (type == TCL_PATH_VOLUME_RELATIVE) {
|
||||
/*
|
||||
* Only Windows has volume-relative paths.
|
||||
@@ -1969,7 +1969,7 @@ Tcl_FSGetNormalizedPath(
|
||||
return NULL;
|
||||
}
|
||||
pureNormalized = 0;
|
||||
#endif /* __WIN32__ */
|
||||
#endif /* _WIN32 */
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -50,7 +50,7 @@ extern "C" {
|
||||
* Exported function declarations:
|
||||
*/
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len,
|
||||
Tcl_DString *dsPtr);
|
||||
@@ -75,7 +75,7 @@ typedef struct TclPlatStubs {
|
||||
int magic;
|
||||
void *hooks;
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
|
||||
char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
|
||||
#endif /* WIN */
|
||||
@@ -97,7 +97,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
|
||||
* Inline function declarations:
|
||||
*/
|
||||
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
#define Tcl_WinUtfToTChar \
|
||||
(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
|
||||
#define Tcl_WinTCharToUtf \
|
||||
|
||||
+32
-40
@@ -1855,9 +1855,39 @@ InterpProcNR2(
|
||||
}
|
||||
|
||||
/*
|
||||
* Process the result code.
|
||||
* Free the stack-allocated compiled locals and CallFrame. It is important
|
||||
* to pop the call frame without freeing it first: the compiledLocals
|
||||
* cannot be freed before the frame is popped, as the local variables must
|
||||
* be deleted. But the compiledLocals must be freed first, as they were
|
||||
* allocated later on the stack.
|
||||
*/
|
||||
|
||||
if (result != TCL_OK) {
|
||||
goto process;
|
||||
}
|
||||
|
||||
done:
|
||||
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
|
||||
int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
|
||||
Tcl_Obj *r = Tcl_GetObjResult(interp);
|
||||
|
||||
TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
|
||||
TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
|
||||
TclGetString(r), r);
|
||||
}
|
||||
|
||||
freePtr = iPtr->framePtr;
|
||||
Tcl_PopCallFrame(interp); /* Pop but do not free. */
|
||||
TclStackFree(interp, freePtr->compiledLocals);
|
||||
/* Free compiledLocals. */
|
||||
TclStackFree(interp, freePtr); /* Free CallFrame. */
|
||||
return result;
|
||||
|
||||
/*
|
||||
* Process any non-TCL_OK result code.
|
||||
*/
|
||||
|
||||
process:
|
||||
switch (result) {
|
||||
case TCL_RETURN:
|
||||
/*
|
||||
@@ -1892,46 +1922,8 @@ InterpProcNR2(
|
||||
*/
|
||||
|
||||
errorProc(interp, procNameObj);
|
||||
|
||||
default:
|
||||
/*
|
||||
* Process other results (OK and non-standard) by doing nothing
|
||||
* special, skipping directly to the code afterwards that cleans up
|
||||
* associated memory.
|
||||
*
|
||||
* Non-standard results are processed by passing them through quickly.
|
||||
* This means they all work as exceptions, unwinding the stack quickly
|
||||
* and neatly. Who knows how well they are handled by third-party code
|
||||
* though...
|
||||
*/
|
||||
|
||||
(void) 0; /* do nothing */
|
||||
}
|
||||
|
||||
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
|
||||
int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
|
||||
Tcl_Obj *r = Tcl_GetObjResult(interp);
|
||||
|
||||
TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
|
||||
TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
|
||||
TclGetString(r), r);
|
||||
}
|
||||
|
||||
/*
|
||||
* Free the stack-allocated compiled locals and CallFrame. It is important
|
||||
* to pop the call frame without freeing it first: the compiledLocals
|
||||
* cannot be freed before the frame is popped, as the local variables must
|
||||
* be deleted. But the compiledLocals must be freed first, as they were
|
||||
* allocated later on the stack.
|
||||
*/
|
||||
|
||||
freePtr = iPtr->framePtr;
|
||||
Tcl_PopCallFrame(interp); /* Pop but do not free. */
|
||||
TclStackFree(interp, freePtr->compiledLocals);
|
||||
/* Free compiledLocals. */
|
||||
TclStackFree(interp, freePtr); /* Free CallFrame. */
|
||||
|
||||
return result;
|
||||
goto done;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
Executable → Regular
+31
-11
@@ -1281,23 +1281,43 @@ Tcl_AppendObjToObj(
|
||||
|
||||
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
|
||||
&& TclIsPureByteArray(appendObjPtr)) {
|
||||
unsigned char *bytesSrc;
|
||||
int lengthSrc, lengthTotal;
|
||||
|
||||
/*
|
||||
* We do not assume that objPtr and appendObjPtr must be distinct!
|
||||
* This makes this code a bit more complex than it otherwise would be,
|
||||
* but in turn makes it much safer.
|
||||
* You might expect the code here to be
|
||||
*
|
||||
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
|
||||
* TclAppendBytesToByteArray(objPtr, bytes, length);
|
||||
*
|
||||
* and essentially all of the time that would be fine. However,
|
||||
* it would run into trouble in the case where objPtr and
|
||||
* appendObjPtr point to the same thing. That may never be a
|
||||
* good idea. It seems to violate Copy On Write, and we don't
|
||||
* have any tests for the situation, since making any Tcl commands
|
||||
* that call Tcl_AppendObjToObj() do that appears impossible
|
||||
* (They honor Copy On Write!). For the sake of extensions that
|
||||
* go off into that realm, though, here's a more complex approach
|
||||
* that can handle all the cases.
|
||||
*/
|
||||
|
||||
/* Get lengths */
|
||||
int lengthSrc;
|
||||
|
||||
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
|
||||
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
|
||||
lengthTotal = length + lengthSrc;
|
||||
if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
|
||||
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
|
||||
}
|
||||
bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
|
||||
TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
|
||||
|
||||
/* Grow buffer enough for the append */
|
||||
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
|
||||
|
||||
/* Reset objPtr back to the original value */
|
||||
Tcl_SetByteArrayLength(objPtr, length);
|
||||
|
||||
/*
|
||||
* Now do the append knowing that buffer growth cannot cause
|
||||
* any trouble.
|
||||
*/
|
||||
|
||||
TclAppendBytesToByteArray(objPtr,
|
||||
Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
@@ -0,0 +1,43 @@
|
||||
/*
|
||||
* tclStringTrim.h --
|
||||
*
|
||||
* This file contains the definition of what characters are to be trimmed
|
||||
* from a string by [string trim] by default. It's only needed by Tcl's
|
||||
* implementation; it does not form a public or private API at all.
|
||||
*
|
||||
* Copyright (c) 1987-1993 The Regents of the University of California.
|
||||
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
||||
* Copyright (c) 1998-2000 Scriptics Corporation.
|
||||
* Copyright (c) 2002 ActiveState Corporation.
|
||||
* Copyright (c) 2003-2013 Donal K. Fellows.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#ifndef TCL_STRING_TRIM_H
|
||||
#define TCL_STRING_TRIM_H
|
||||
|
||||
/*
|
||||
* Default set of characters to trim in [string trim] and friends. This is a
|
||||
* UTF-8 literal string containing all Unicode space characters. [TIP #413]
|
||||
*/
|
||||
|
||||
MODULE_SCOPE const char tclDefaultTrimSet[];
|
||||
|
||||
/*
|
||||
* The whitespace trimming set used when [concat]enating. This is a subset of
|
||||
* the above, and deliberately so.
|
||||
*/
|
||||
|
||||
#define CONCAT_TRIM_SET " \f\v\r\t\n"
|
||||
|
||||
#endif /* TCL_STRING_TRIM_H */
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
+10
-10
@@ -90,7 +90,7 @@ static unsigned short TclWinNToHS(unsigned short ns) {
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef __WIN32__
|
||||
#ifdef _WIN32
|
||||
# define TclUnixWaitForFile 0
|
||||
# define TclUnixCopyFile 0
|
||||
# define TclUnixOpenTemporaryFile 0
|
||||
@@ -557,7 +557,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TCL_STUB_MAGIC,
|
||||
0,
|
||||
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
TclGetAndDetachPids, /* 0 */
|
||||
TclpCloseFile, /* 1 */
|
||||
TclpCreateCommandChannel, /* 2 */
|
||||
@@ -590,7 +590,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TclWinCPUID, /* 29 */
|
||||
TclUnixOpenTemporaryFile, /* 30 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
TclWinConvertError, /* 0 */
|
||||
TclWinConvertWSAError, /* 1 */
|
||||
TclWinGetServByName, /* 2 */
|
||||
@@ -661,7 +661,7 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
static const TclPlatStubs tclPlatStubs = {
|
||||
TCL_STUB_MAGIC,
|
||||
0,
|
||||
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
Tcl_WinUtfToTChar, /* 0 */
|
||||
Tcl_WinTCharToUtf, /* 1 */
|
||||
#endif /* WIN */
|
||||
@@ -758,19 +758,19 @@ const TclStubs tclStubs = {
|
||||
Tcl_DbCkalloc, /* 6 */
|
||||
Tcl_DbCkfree, /* 7 */
|
||||
Tcl_DbCkrealloc, /* 8 */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
Tcl_CreateFileHandler, /* 9 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) /* WIN */
|
||||
#if defined(_WIN32) /* WIN */
|
||||
0, /* 9 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
Tcl_CreateFileHandler, /* 9 */
|
||||
#endif /* MACOSX */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
Tcl_DeleteFileHandler, /* 10 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) /* WIN */
|
||||
#if defined(_WIN32) /* WIN */
|
||||
0, /* 10 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
@@ -932,10 +932,10 @@ const TclStubs tclStubs = {
|
||||
Tcl_GetMaster, /* 164 */
|
||||
Tcl_GetNameOfExecutable, /* 165 */
|
||||
Tcl_GetObjResult, /* 166 */
|
||||
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
|
||||
Tcl_GetOpenFile, /* 167 */
|
||||
#endif /* UNIX */
|
||||
#if defined(__WIN32__) /* WIN */
|
||||
#if defined(_WIN32) /* WIN */
|
||||
0, /* 167 */
|
||||
#endif /* WIN */
|
||||
#ifdef MAC_OSX_TCL /* MACOSX */
|
||||
|
||||
@@ -0,0 +1,58 @@
|
||||
/*
|
||||
* tclStubLibTbl.c --
|
||||
*
|
||||
* Stub object that will be statically linked into extensions that want
|
||||
* to access Tcl.
|
||||
*
|
||||
* Copyright (c) 1998-1999 by Scriptics Corporation.
|
||||
* Copyright (c) 1998 Paul Duffin.
|
||||
*
|
||||
* See the file "license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclInitStubTable --
|
||||
*
|
||||
* Initialize the stub table, using the structure pointed at
|
||||
* by the "version" argument.
|
||||
*
|
||||
* Results:
|
||||
* Outputs the value of the "version" argument.
|
||||
*
|
||||
* Side effects:
|
||||
* Sets the stub table pointers.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
MODULE_SCOPE const char *
|
||||
TclInitStubTable(
|
||||
const char *version) /* points to the version field of a
|
||||
TclStubInfoType structure variable. */
|
||||
{
|
||||
tclStubsPtr = ((const TclStubInfoType *) version)->stubs;
|
||||
|
||||
if (tclStubsPtr->hooks) {
|
||||
tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
|
||||
tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
|
||||
tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
|
||||
} else {
|
||||
tclPlatStubsPtr = NULL;
|
||||
tclIntStubsPtr = NULL;
|
||||
tclIntPlatStubsPtr = NULL;
|
||||
}
|
||||
|
||||
return version;
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
* c-basic-offset: 4
|
||||
* fill-column: 78
|
||||
* End:
|
||||
*/
|
||||
+3
-3
@@ -414,7 +414,7 @@ static int TestNRELevels(ClientData clientData,
|
||||
static int TestInterpResolverCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
#if defined(HAVE_CPUID) || defined(__WIN32__)
|
||||
#if defined(HAVE_CPUID) || defined(_WIN32)
|
||||
static int TestcpuidCmd(ClientData dummy,
|
||||
Tcl_Interp* interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -681,7 +681,7 @@ Tcltest_Init(
|
||||
NULL, NULL);
|
||||
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
|
||||
NULL, NULL);
|
||||
#if defined(HAVE_CPUID) || defined(__WIN32__)
|
||||
#if defined(HAVE_CPUID) || defined(_WIN32)
|
||||
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
|
||||
(ClientData) 0, NULL);
|
||||
#endif
|
||||
@@ -6648,7 +6648,7 @@ TestNumUtfCharsCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
#if defined(HAVE_CPUID) || defined(__WIN32__)
|
||||
#if defined(HAVE_CPUID) || defined(_WIN32)
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
@@ -14,7 +14,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
#ifdef WIN32
|
||||
#ifdef _WIN32
|
||||
|
||||
/*
|
||||
* The information about each joinable thread is remembered in a structure as
|
||||
@@ -305,7 +305,7 @@ TclSignalExitThread(
|
||||
|
||||
Tcl_MutexUnlock(&threadPtr->threadMutex);
|
||||
}
|
||||
#endif /* WIN32 */
|
||||
#endif /* _WIN32 */
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
|
||||
+10
-6
@@ -14,6 +14,7 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
#include "tclParse.h"
|
||||
#include "tclStringTrim.h"
|
||||
#include <math.h>
|
||||
|
||||
/*
|
||||
@@ -1768,8 +1769,7 @@ TclTrimLeft(
|
||||
*/
|
||||
|
||||
/* The whitespace characters trimmed during [concat] operations */
|
||||
#define CONCAT_WS " \f\v\r\t\n"
|
||||
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)
|
||||
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1)
|
||||
|
||||
char *
|
||||
Tcl_Concat(
|
||||
@@ -1825,7 +1825,8 @@ Tcl_Concat(
|
||||
* Trim away the leading whitespace.
|
||||
*/
|
||||
|
||||
trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
|
||||
trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
element += trim;
|
||||
elemLength -= trim;
|
||||
|
||||
@@ -1834,7 +1835,8 @@ Tcl_Concat(
|
||||
* a final backslash character.
|
||||
*/
|
||||
|
||||
trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
|
||||
trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
trim -= trim && (element[elemLength - trim - 1] == '\\');
|
||||
elemLength -= trim;
|
||||
|
||||
@@ -1959,7 +1961,8 @@ Tcl_ConcatObj(
|
||||
* Trim away the leading whitespace.
|
||||
*/
|
||||
|
||||
trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
|
||||
trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
element += trim;
|
||||
elemLength -= trim;
|
||||
|
||||
@@ -1968,7 +1971,8 @@ Tcl_ConcatObj(
|
||||
* a final backslash character.
|
||||
*/
|
||||
|
||||
trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE);
|
||||
trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET,
|
||||
CONCAT_WS_SIZE);
|
||||
trim -= trim && (element[elemLength - trim - 1] == '\\');
|
||||
elemLength -= trim;
|
||||
|
||||
|
||||
+8
-38
@@ -3012,52 +3012,22 @@ ZlibTransformInput(
|
||||
return -1;
|
||||
} else if (readBytes == 0) {
|
||||
/*
|
||||
* Check wether we hit on EOF in 'parent' or not. If not,
|
||||
* differentiate between blocking and non-blocking modes. In
|
||||
* non-blocking mode we ran temporarily out of data. Signal this
|
||||
* to the caller via EWOULDBLOCK and error return (-1). In the
|
||||
* other cases we simply return what we got and let the caller
|
||||
* wait for more. On the other hand, if we got an EOF we have to
|
||||
* convert and flush all waiting partial data.
|
||||
*/
|
||||
|
||||
if (!Tcl_Eof(cd->parent)) {
|
||||
/*
|
||||
* The state of the seek system is unchanged!
|
||||
*/
|
||||
|
||||
if ((gotBytes == 0) && (cd->flags & ASYNC)) {
|
||||
*errorCodePtr = EWOULDBLOCK;
|
||||
return -1;
|
||||
}
|
||||
return gotBytes;
|
||||
}
|
||||
|
||||
/*
|
||||
* (Semi-)Eof in parent.
|
||||
*
|
||||
* Now this is a bit different. The partial data waiting is
|
||||
* converted and returned.
|
||||
* The 'parent' is at EOF. It will not deliver us any more
|
||||
* bytes. Make one last decompression attempt where we flush
|
||||
* the streams.
|
||||
*/
|
||||
|
||||
if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) {
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (Tcl_DStringLength(&cd->decompressed) == 0) {
|
||||
/*
|
||||
* The drain delivered nothing. Time to deliver what we've
|
||||
* got.
|
||||
*/
|
||||
|
||||
return gotBytes;
|
||||
}
|
||||
|
||||
/*
|
||||
* Reset eof, force caller to drain result buffer.
|
||||
* Note that in the case where gotBytes == 0 (nothing in
|
||||
* the decompressed buffer to begin with) and the flush
|
||||
* also produce no new output, we are returning 0, which
|
||||
* signals the EOF to our caller.
|
||||
*/
|
||||
|
||||
((Channel *) cd->parent)->state->flags &= ~CHANNEL_EOF;
|
||||
return gotBytes + ResultCopy(cd, buf, toRead);
|
||||
} else /* readBytes > 0 */ {
|
||||
/*
|
||||
* Transform the read chunk, which was not empty. Anything we get
|
||||
|
||||
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Executable → Regular
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user