Compare commits
169
Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
63be474164 | ||
|
|
5e3ca11761 | ||
|
|
6ab540f5ff | ||
|
|
63b0fef31a | ||
|
|
bb503004b6 | ||
|
|
267cdaec03 | ||
|
|
a2ce3dab9b | ||
|
|
6a4d06759e | ||
|
|
6966f0a2b1 | ||
|
|
89a84af271 | ||
|
|
bb5d24622f | ||
|
|
813979693c | ||
|
|
c8da3bbfaf | ||
|
|
35f5b82868 | ||
|
|
5e7a1545a6 | ||
|
|
f4651a5660 | ||
|
|
a0290b85c5 | ||
|
|
8145564d30 | ||
|
|
66ef201ad7 | ||
|
|
6d943ef7b5 | ||
|
|
1c13d543f4 | ||
|
|
263de53394 | ||
|
|
a410c0d8d5 | ||
|
|
ecec1703aa | ||
|
|
36a1a69178 | ||
|
|
edb38932e8 | ||
|
|
46aab3eb09 | ||
|
|
ce025f259b | ||
|
|
f6af18a947 | ||
|
|
b729965a3c | ||
|
|
0cab7d260b | ||
|
|
708eadd19e | ||
|
|
7bbadfe0e0 | ||
|
|
4523d8df2c | ||
|
|
791f1c2741 | ||
|
|
d431841a06 | ||
|
|
dffe6bc7f1 | ||
|
|
423f761169 | ||
|
|
ba42e43e97 | ||
|
|
4f1ea4779b | ||
|
|
e6fdfbe93b | ||
|
|
bd706be303 | ||
|
|
4e12ee1bc4 | ||
|
|
7672af7212 | ||
|
|
eae621b175 | ||
|
|
5eef06ea24 | ||
|
|
9333525d11 | ||
|
|
911c1c6237 | ||
|
|
49a9e59311 | ||
|
|
242d4d7095 | ||
|
|
9cb3b15616 | ||
|
|
6d0cc0c589 | ||
|
|
d9bc6cbae2 | ||
|
|
388266030b | ||
|
|
ede72e80ac | ||
|
|
7bf3f83abd | ||
|
|
d3fd405e6b | ||
|
|
eed54b6281 | ||
|
|
6dbdfc31d2 | ||
|
|
35d6c2453e | ||
|
|
f7f4cbb151 | ||
|
|
f5e8751307 | ||
|
|
7855612da6 | ||
|
|
7f26fedbcc | ||
|
|
47e9dbdc37 | ||
|
|
8fd1568405 | ||
|
|
78ee8c697e | ||
|
|
08f43a1ff4 | ||
|
|
1f71d7079b | ||
|
|
5cef8b0f8e | ||
|
|
5f0cf291f5 | ||
|
|
5500074eff | ||
|
|
db133f0144 | ||
|
|
66525c95ee | ||
|
|
86c6a11cdb | ||
|
|
13bdb0305c | ||
|
|
2a19591dc7 | ||
|
|
411bfad9f4 | ||
|
|
f58e9ed842 | ||
|
|
e383cd7b26 | ||
|
|
3a3fd2954f | ||
|
|
f44e7c1795 | ||
|
|
04604552b2 | ||
|
|
b5d6b4f138 | ||
|
|
ad02c0b532 | ||
|
|
28e500cbf9 | ||
|
|
637c7dbc7e | ||
|
|
49879791f4 | ||
|
|
8262e514d0 | ||
|
|
5a8d06b076 | ||
|
|
008f1c98d0 | ||
|
|
383c53f80e | ||
|
|
ba9cf35aa3 | ||
|
|
db41a49d9c | ||
|
|
cbbab84b71 | ||
|
|
47152d94c1 | ||
|
|
5b5bd699ff | ||
|
|
69868ee129 | ||
|
|
1dd89810eb | ||
|
|
53795bd199 | ||
|
|
603e23c2a9 | ||
|
|
3f03f8189e | ||
|
|
c576cbec93 | ||
|
|
5c4f8d88b5 | ||
|
|
9c5c1a721f | ||
|
|
bf868c1c56 | ||
|
|
a69614b432 | ||
|
|
ef7ea2c390 | ||
|
|
5470f13299 | ||
|
|
c0effc5b46 | ||
|
|
15f27ca8f2 | ||
|
|
b5273bc1fa | ||
|
|
cdba31b9d5 | ||
|
|
bb504b06b4 | ||
|
|
55717aeaea | ||
|
|
8615597984 | ||
|
|
a333bbaa12 | ||
|
|
2bc847ac57 | ||
|
|
9283692888 | ||
|
|
017b8b10b6 | ||
|
|
4ddfe70ae2 | ||
|
|
53dc25e532 | ||
|
|
542b57cf21 | ||
|
|
e36fd891e4 | ||
|
|
954b241f34 | ||
|
|
3f56494834 | ||
|
|
6a811b97b9 | ||
|
|
1900da6d24 | ||
|
|
8f38d12eee | ||
|
|
3f5f45f002 | ||
|
|
e6528cb48d | ||
|
|
041184928d | ||
|
|
b108063f75 | ||
|
|
9ce336b3d1 | ||
|
|
b5da760544 | ||
|
|
7e520e2089 | ||
|
|
07af7d5337 | ||
|
|
696a9ba3f9 | ||
|
|
9db6776dbe | ||
|
|
1c6a242b2e | ||
|
|
a58db736cf | ||
|
|
449ea43718 | ||
|
|
260c2634b9 | ||
|
|
6d0db57c02 | ||
|
|
11593d64b8 | ||
|
|
e4a0b9dbfd | ||
|
|
bb770e33f8 | ||
|
|
d048128004 | ||
|
|
eecece2afe | ||
|
|
74c7068a25 | ||
|
|
59360240b3 | ||
|
|
91ba235b3c | ||
|
|
d13fe1e431 | ||
|
|
f361c1805c | ||
|
|
52b8ad45d1 | ||
|
|
9b6c85d82e | ||
|
|
88b8fc30a2 | ||
|
|
1a0463ea04 | ||
|
|
cab91124b4 | ||
|
|
8d9ea7c132 | ||
|
|
c5558280d7 | ||
|
|
3913f5f7ae | ||
|
|
e8c69aa654 | ||
|
|
b2b37d97cf | ||
|
|
4796adf5cb | ||
|
|
2c02c2ae5d | ||
|
|
ef824b7395 | ||
|
|
2930daf68c | ||
|
|
0481e3ca74 |
@@ -1,6 +1,6 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<projectDescription>
|
||||
<name>tcl9</name>
|
||||
<name>tcl8</name>
|
||||
<comment></comment>
|
||||
<projects>
|
||||
</projects>
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
README: Tcl
|
||||
This is the Tcl 9.0a0 source distribution.
|
||||
This is the Tcl 8.7a2 source distribution.
|
||||
http://sourceforge.net/projects/tcl/files/Tcl/
|
||||
You can get any source release of Tcl from the URL above.
|
||||
|
||||
@@ -49,7 +49,7 @@ and selling it either in whole or in part. See the file
|
||||
|
||||
Extensive documentation is available at our website.
|
||||
The home page for this release, including new features, is
|
||||
http://www.tcl.tk/software/tcltk/9.0.html
|
||||
http://www.tcl.tk/software/tcltk/8.7.html
|
||||
|
||||
Detailed release notes can be found at the file distributions page
|
||||
by clicking on the relevant version.
|
||||
@@ -61,9 +61,9 @@ Information about Tcl itself can be found at
|
||||
There have been many Tcl books on the market. Many are mentioned in the Wiki:
|
||||
http://wiki.tcl.tk/_/ref?N=25206
|
||||
|
||||
To view the complete set of reference manual entries for Tcl 9.0 online,
|
||||
To view the complete set of reference manual entries for Tcl 8.7 online,
|
||||
visit the URL:
|
||||
http://www.tcl.tk/man/tcl9.0/
|
||||
http://www.tcl.tk/man/tcl8.7/
|
||||
|
||||
2a. Unix Documentation
|
||||
----------------------
|
||||
|
||||
+6
-1
@@ -9,7 +9,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
|
||||
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -30,6 +30,8 @@ int
|
||||
.sp
|
||||
\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR)
|
||||
.sp
|
||||
\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR)
|
||||
.sp
|
||||
\fBTcl_GetErrorLine\fR(\fIinterp\fR)
|
||||
.sp
|
||||
\fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR)
|
||||
@@ -243,6 +245,9 @@ The procedure \fBTcl_SetErrorCode\fR is also used to set the
|
||||
record instead of a value. Otherwise, it is similar to
|
||||
\fBTcl_SetObjErrorCode\fR in behavior.
|
||||
.PP
|
||||
\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that
|
||||
instead of taking a variable number of arguments it takes an argument list.
|
||||
.PP
|
||||
The procedure \fBTcl_GetErrorLine\fR is used to read the integer value
|
||||
of the \fB\-errorline\fR return option without the overhead of a full
|
||||
call to \fBTcl_GetReturnOptions\fR. Likewise, \fBTcl_SetErrorLine\fR
|
||||
|
||||
+2
-1
@@ -30,7 +30,8 @@ or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR
|
||||
return with an appropriate message. The particular script
|
||||
evaluation procedures of Tcl that act in the manner are
|
||||
\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
|
||||
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR and \fBTcl_VarEval\fR.
|
||||
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
|
||||
\fBTcl_VarEvalVA\fR.
|
||||
.PP
|
||||
However, if \fBTcl_AllowExceptions\fR is invoked immediately before
|
||||
calling one of those a procedures, then arbitrary completion
|
||||
|
||||
@@ -0,0 +1,47 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1989-1993 The Regents of the University of California.
|
||||
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_Backslash \- parse a backslash sequence
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
.sp
|
||||
char
|
||||
\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS char *countPtr out
|
||||
.AP char *src in
|
||||
Pointer to a string starting with a backslash.
|
||||
.AP int *countPtr out
|
||||
If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled
|
||||
in with number of characters in the backslash sequence, including
|
||||
the backslash character.
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The use of \fBTcl_Backslash\fR is deprecated in favor of
|
||||
\fBTcl_UtfBackslash\fR.
|
||||
.PP
|
||||
This is a utility procedure provided for backwards compatibility with
|
||||
non-internationalized Tcl extensions. It parses a backslash sequence and
|
||||
returns the low byte of the Unicode character corresponding to the sequence.
|
||||
\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
|
||||
characters in the backslash sequence.
|
||||
.PP
|
||||
See the Tcl manual entry for information on the valid backslash sequences.
|
||||
All of the sequences described in the Tcl manual entry are supported by
|
||||
\fBTcl_Backslash\fR.
|
||||
.SH "SEE ALSO"
|
||||
Tcl(n), Tcl_UtfBackslash(3)
|
||||
|
||||
.SH KEYWORDS
|
||||
backslash, parse
|
||||
@@ -0,0 +1,162 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1989-1993 The Regents of the University of California.
|
||||
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
|
||||
.SH "NOTICE OF EVENTUAL DEPRECATION"
|
||||
.PP
|
||||
The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions
|
||||
are rendered somewhat obsolete by the ability to create functions for
|
||||
expressions by placing commands in the \fBtcl::mathfunc\fR namespace,
|
||||
as described in the \fBmathfunc\fR manual page; the API described on
|
||||
this page is not expected to be maintained indefinitely.
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
.sp
|
||||
void
|
||||
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr,
|
||||
clientDataPtr\fR)
|
||||
.sp
|
||||
Tcl_Obj *
|
||||
\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_ValueType *clientDataPtr out
|
||||
.AP Tcl_Interp *interp in
|
||||
Interpreter in which new function will be defined.
|
||||
.AP "const char" *name in
|
||||
Name for new function.
|
||||
.AP int numArgs in
|
||||
Number of arguments to new function; also gives size of \fIargTypes\fR array.
|
||||
.AP Tcl_ValueType *argTypes in
|
||||
Points to an array giving the permissible types for each argument to
|
||||
function.
|
||||
.AP Tcl_MathProc *proc in
|
||||
Procedure that implements the function.
|
||||
.AP ClientData clientData in
|
||||
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
|
||||
.AP int *numArgsPtr out
|
||||
Points to a variable that will be set to contain the number of
|
||||
arguments to the function.
|
||||
.AP Tcl_ValueType **argTypesPtr out
|
||||
Points to a variable that will be set to contain a pointer to an array
|
||||
giving the permissible types for each argument to the function which
|
||||
will need to be freed up using \fITcl_Free\fR.
|
||||
.AP Tcl_MathProc **procPtr out
|
||||
Points to a variable that will be set to contain a pointer to the
|
||||
implementation code for the function (or NULL if the function is
|
||||
implemented directly in bytecode).
|
||||
.AP ClientData *clientDataPtr out
|
||||
Points to a variable that will be set to contain the clientData
|
||||
argument passed to \fITcl_CreateMathFunc\fR when the function was
|
||||
created if the function is not implemented directly in bytecode.
|
||||
.AP "const char" *pattern in
|
||||
Pattern to match against function names so as to filter them (by
|
||||
passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
Tcl allows a number of mathematical functions to be used in
|
||||
expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
|
||||
These functions are represented by commands in the namespace,
|
||||
\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is
|
||||
an obsolete way for applications to add additional functions
|
||||
to those already provided by Tcl or to replace existing functions.
|
||||
It should not be used by new applications, which should create
|
||||
math functions using \fBTcl_CreateObjCommand\fR to create a command
|
||||
in the \fBtcl::mathfunc\fR namespace.
|
||||
.PP
|
||||
In the \fBTcl_CreateMathFunc\fR interface,
|
||||
\fIName\fR is the name of the function as it will appear in expressions.
|
||||
If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR
|
||||
namespace, then a new command is created in that namespace.
|
||||
If \fIname\fR does exist, then the existing function is replaced.
|
||||
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
|
||||
Each entry in the \fIargTypes\fR array must be
|
||||
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR,
|
||||
or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an
|
||||
integer, a double-precision floating value, a wide (64-bit) integer,
|
||||
or any, respectively.
|
||||
.PP
|
||||
Whenever the function is invoked in an expression Tcl will invoke
|
||||
\fIproc\fR. \fIProc\fR should have arguments and result that match
|
||||
the type \fBTcl_MathProc\fR:
|
||||
.PP
|
||||
.CS
|
||||
typedef int \fBTcl_MathProc\fR(
|
||||
ClientData \fIclientData\fR,
|
||||
Tcl_Interp *\fIinterp\fR,
|
||||
Tcl_Value *\fIargs\fR,
|
||||
Tcl_Value *\fIresultPtr\fR);
|
||||
.CE
|
||||
.PP
|
||||
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
|
||||
arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
|
||||
\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
|
||||
which describe the actual arguments to the function:
|
||||
.PP
|
||||
.CS
|
||||
typedef struct Tcl_Value {
|
||||
Tcl_ValueType \fItype\fR;
|
||||
long \fIintValue\fR;
|
||||
double \fIdoubleValue\fR;
|
||||
Tcl_WideInt \fIwideValue\fR;
|
||||
} \fBTcl_Value\fR;
|
||||
.CE
|
||||
.PP
|
||||
The \fItype\fR field indicates the type of the argument and is
|
||||
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR.
|
||||
It will match the \fIargTypes\fR value specified for the function unless
|
||||
the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts
|
||||
the argument supplied in the expression to the type requested in
|
||||
\fIargTypes\fR, if that is necessary.
|
||||
Depending on the value of the \fItype\fR field, the \fIintValue\fR,
|
||||
\fIdoubleValue\fR or \fIwideValue\fR
|
||||
field will contain the actual value of the argument.
|
||||
.PP
|
||||
\fIProc\fR should compute its result and store it either as an integer
|
||||
in \fIresultPtr->intValue\fR or as a floating value in
|
||||
\fIresultPtr->doubleValue\fR.
|
||||
It should set also \fIresultPtr->type\fR to one of
|
||||
\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR
|
||||
to indicate which value was set.
|
||||
Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR.
|
||||
If an error occurs while executing the function, \fIproc\fR should
|
||||
return \fBTCL_ERROR\fR and leave an error message in the interpreter's result.
|
||||
.PP
|
||||
\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
|
||||
function \fIname\fR that were passed to a preceding
|
||||
\fBTcl_CreateMathFunc\fR call. Normally, the return code is
|
||||
\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
|
||||
is returned and an error message is placed in the interpreter's
|
||||
result.
|
||||
.PP
|
||||
If an error did not occur, the array reference placed in the variable
|
||||
pointed to by \fIargTypesPtr\fR is newly allocated, and should be
|
||||
released by passing it to \fBTcl_Free\fR. Some functions (the
|
||||
standard set implemented in the core, and those defined by placing
|
||||
commands in the \fBtcl::mathfunc\fR namespace) do not have
|
||||
argument type information; attempting to retrieve values for
|
||||
them causes a NULL to be stored in the variable pointed to by
|
||||
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
|
||||
will not be modified. The variable pointed to by \fInumArgsPointer\fR
|
||||
will contain -1, and no argument types will be stored in the variable
|
||||
pointed to by \fIargTypesPointer\fR.
|
||||
.PP
|
||||
\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all
|
||||
the math functions defined in the interpreter whose name matches
|
||||
\fIpattern\fR. The returned value has a reference count of zero.
|
||||
.SH "SEE ALSO"
|
||||
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)
|
||||
.SH KEYWORDS
|
||||
expression, mathematical function
|
||||
+7
-1
@@ -9,7 +9,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
|
||||
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -34,6 +34,8 @@ char *
|
||||
.sp
|
||||
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
|
||||
.sp
|
||||
\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
|
||||
.sp
|
||||
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
|
||||
.sp
|
||||
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
|
||||
@@ -126,6 +128,10 @@ caller to fill in the new space.
|
||||
even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
|
||||
will still need to be called.
|
||||
.PP
|
||||
\fBTcl_DStringTrunc\fR changes the length of a dynamic string.
|
||||
This procedure is now deprecated. \fBTcl_DStringSetLength\fR should
|
||||
be used instead.
|
||||
.PP
|
||||
\fBTcl_DStringFree\fR should be called when you are finished using
|
||||
the string. It frees up any memory that was allocated for the string
|
||||
and reinitializes the string's value to an empty string.
|
||||
|
||||
+17
-2
@@ -8,7 +8,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
|
||||
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -62,6 +62,12 @@ Tcl_Obj *
|
||||
.sp
|
||||
int
|
||||
\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR)
|
||||
.sp
|
||||
const char *
|
||||
\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS "const Tcl_EncodingType" *dstWrotePtr in/out
|
||||
.AP Tcl_Interp *interp in
|
||||
@@ -281,7 +287,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned.
|
||||
\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
|
||||
consisting of the names of all the encodings that are currently defined
|
||||
or can be dynamically loaded, searching the encoding path specified by
|
||||
\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the
|
||||
\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the
|
||||
dynamically-loadable encoding files contain valid data, but merely that they
|
||||
exist.
|
||||
.PP
|
||||
@@ -396,6 +402,15 @@ are not verified as existing readable filesystem directories. When
|
||||
searching for encoding data files takes place, and non-existent or
|
||||
non-readable filesystem directories on the \fIsearchPath\fR are silently
|
||||
ignored.
|
||||
.PP
|
||||
\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR
|
||||
are obsolete interfaces best replaced with calls to
|
||||
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR.
|
||||
They are called to access and set the first element of the \fIsearchPath\fR
|
||||
list. Since Tcl searches \fIsearchPath\fR for encoding data files in
|
||||
list order, these routines establish the
|
||||
.QW default
|
||||
directory in which to find encoding data files.
|
||||
.SH "ENCODING FILES"
|
||||
Space would prohibit precompiling into Tcl every possible encoding
|
||||
algorithm, so many encodings are stored on disk as dynamically-loadable
|
||||
|
||||
+19
-3
@@ -10,7 +10,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval \- execute Tcl scripts
|
||||
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -38,6 +38,9 @@ int
|
||||
.sp
|
||||
int
|
||||
\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_Interp **termPtr
|
||||
.AP Tcl_Interp *interp in
|
||||
@@ -64,6 +67,9 @@ first null byte are used.
|
||||
Points to first byte of script to execute (null-terminated and UTF-8).
|
||||
.AP char *part in
|
||||
String forming part of a Tcl script.
|
||||
.AP va_list argList in
|
||||
An argument list which must have been initialized using
|
||||
\fBva_start\fR, and cleared using \fBva_end\fR.
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
@@ -122,10 +128,16 @@ might be a UTF-8 special code. The string is parsed and executed directly
|
||||
bytecodes. In situations where it is known that the script will never be
|
||||
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
|
||||
\fBTcl_Eval\fR returns a completion code and result just like
|
||||
\fBTcl_EvalObjEx\fR.
|
||||
\fBTcl_EvalObjEx\fR. Note: for backward compatibility with versions before
|
||||
Tcl 8.0, \fBTcl_Eval\fR copies the value result in \fIinterp\fR to
|
||||
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
|
||||
This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
|
||||
does not do the copy.
|
||||
.PP
|
||||
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
|
||||
additional arguments \fInumBytes\fR and \fIflags\fR.
|
||||
additional arguments \fInumBytes\fR and \fIflags\fR. For the
|
||||
efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred
|
||||
over \fBTcl_Eval\fR.
|
||||
.PP
|
||||
\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures
|
||||
that are now deprecated. They are similar to \fBTcl_EvalEx\fR and
|
||||
@@ -141,6 +153,10 @@ It returns the result of the command and also modifies
|
||||
\fIinterp->result\fR in the same way as \fBTcl_Eval\fR.
|
||||
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
|
||||
of arguments. \fBTcl_VarEval\fR is now deprecated.
|
||||
.PP
|
||||
\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
|
||||
instead of taking a variable number of arguments it takes an argument
|
||||
list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.
|
||||
|
||||
.SH "FLAG BITS"
|
||||
.PP
|
||||
|
||||
+5
-2
@@ -64,9 +64,12 @@ if the first such characters are
|
||||
then \fIsrc\fR is expected to be in octal form; otherwise,
|
||||
if the first such characters are
|
||||
.QW \fB0b\fR
|
||||
then \fIsrc\fR is expected to be in binary form; otherwise,
|
||||
if the first such character is
|
||||
.QW \fB0\fR
|
||||
then \fIsrc\fR
|
||||
is expected to be in binary form; otherwise, \fIsrc\fR is
|
||||
expected to be in decimal form.
|
||||
is expected to be in octal form; otherwise, \fIsrc\fR
|
||||
is expected to be in decimal form.
|
||||
.PP
|
||||
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
|
||||
number, which is: white space; a sign; a sequence of digits; a
|
||||
|
||||
+3
-3
@@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the
|
||||
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
|
||||
.IP 3) 5
|
||||
Link the extension with the Tcl stubs library instead of the standard
|
||||
Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms,
|
||||
the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the
|
||||
library name is \fItclstub90.lib\fR.
|
||||
Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms,
|
||||
the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the
|
||||
library name is \fItclstub86.lib\fR.
|
||||
.PP
|
||||
If the extension also requires the Tk API, it must also call
|
||||
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
|
||||
|
||||
@@ -33,6 +33,19 @@ the pointer as described below is no longer supported. The supported
|
||||
public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR,
|
||||
\fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead.
|
||||
.PP
|
||||
For legacy programs and extensions no longer being maintained, compiles
|
||||
against the Tcl 8.6 header files are only possible with the compiler
|
||||
directives
|
||||
.CS
|
||||
#define USE_INTERP_RESULT
|
||||
.CE
|
||||
and/or
|
||||
.CS
|
||||
#define USE_INTERP_ERRORLINE
|
||||
.CE
|
||||
depending on which fields of the \fBTcl_Interp\fR struct are accessed.
|
||||
These directives may be embedded in code or supplied via compiler options.
|
||||
.PP
|
||||
The \fIresult\fR and \fIfreeProc\fR fields are used to return
|
||||
results or error messages from commands.
|
||||
This information is returned by command procedures back to \fBTcl_Eval\fR,
|
||||
|
||||
+31
-13
@@ -9,18 +9,18 @@
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
|
||||
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tclOO.h>\fR
|
||||
.sp
|
||||
Tcl_Method
|
||||
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
|
||||
methodTypePtr, clientData\fR)
|
||||
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
|
||||
clientData\fR)
|
||||
.sp
|
||||
Tcl_Method
|
||||
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
|
||||
methodTypePtr, clientData\fR)
|
||||
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
|
||||
clientData\fR)
|
||||
.sp
|
||||
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
|
||||
.sp
|
||||
@@ -35,8 +35,13 @@ Tcl_Object
|
||||
Tcl_Obj *
|
||||
\fBTcl_MethodName\fR(\fImethod\fR)
|
||||
.sp
|
||||
.VS TIP500
|
||||
int
|
||||
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
|
||||
.VE TIP500
|
||||
.sp
|
||||
int
|
||||
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
|
||||
@@ -66,10 +71,15 @@ The class to create the method in.
|
||||
.AP Tcl_Obj *nameObj in
|
||||
The name of the method to create. Should not be NULL unless creating
|
||||
constructors or destructors.
|
||||
.AP int isPublic in
|
||||
A flag saying what the visibility of the method is. The only supported public
|
||||
values of this flag are 0 for a non-exported method, and 1 for an exported
|
||||
method.
|
||||
.AP int flags in
|
||||
A flag saying (currently) what the visibility of the method is. The supported
|
||||
public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
|
||||
for backward compatibility) for an exported method,
|
||||
\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
|
||||
compatibility) for a non-exported method,
|
||||
.VS TIP500
|
||||
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
|
||||
.VE TIP500
|
||||
.AP Tcl_MethodType *methodTypePtr in
|
||||
A description of the type of the method to create, or the type of method to
|
||||
compare against.
|
||||
@@ -105,8 +115,12 @@ Given a method, the entity that declared it can be found using
|
||||
attached to (or NULL if the method is not attached to any class) and
|
||||
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
|
||||
attached to (or NULL if the method is not attached to an object). The name of
|
||||
the method can be retrieved with \fBTcl_MethodName\fR and whether the method
|
||||
is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
|
||||
the method can be retrieved with \fBTcl_MethodName\fR, whether the method
|
||||
is exported is retrieved with \fBTcl_MethodIsPublic\fR,
|
||||
.VS TIP500
|
||||
and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
|
||||
.VE TIP500
|
||||
The type of the method
|
||||
can also be introspected upon to a limited degree; the function
|
||||
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
|
||||
assigning the per-method \fIclientData\fR to the variable pointed to by
|
||||
@@ -117,8 +131,12 @@ Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
|
||||
which
|
||||
create a method attached to a class or an object respectively. In both cases,
|
||||
the \fInameObj\fR argument gives the name of the method to create, the
|
||||
\fIisPublic\fR argument states whether the method should be exported
|
||||
initially, the \fImethodTypePtr\fR argument describes the implementation of
|
||||
\fIflags\fR argument states whether the method should be exported
|
||||
initially
|
||||
.VS TIP500
|
||||
or be marked as a private method,
|
||||
.VE TIP500
|
||||
the \fImethodTypePtr\fR argument describes the implementation of
|
||||
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
|
||||
argument gives some implementation-specific data that is passed on to the
|
||||
implementation of the method when it is called.
|
||||
|
||||
+18
-1
@@ -7,7 +7,7 @@
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
Tcl_Panic, Tcl_SetPanicProc \- report fatal error and abort
|
||||
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -16,8 +16,14 @@ void
|
||||
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
|
||||
.sp
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_PanicProc *panicProc
|
||||
.AP "const char*" format in
|
||||
@@ -51,6 +57,14 @@ message is sent to the debugger in stead. If the windows executable
|
||||
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
|
||||
system dialog box is used to display the panic message.
|
||||
.PP
|
||||
If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
|
||||
and you want to implicitly use the stderr channel of your
|
||||
application's C runtime (in stead of the stderr channel of the
|
||||
C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
|
||||
with \fBTcl_ConsolePanic\fR as its argument. On platforms which
|
||||
only have one C runtime (almost all platforms except Windows)
|
||||
\fBTcl_ConsolePanic\fR is equivalent to NULL.
|
||||
.PP
|
||||
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
|
||||
\fBTcl_Panic\fR. The \fIpanicProc\fR argument should match the
|
||||
type \fBTcl_PanicProc\fR:
|
||||
@@ -77,6 +91,9 @@ the Tcl library, \fBTcl_Panic\fR is a public function and may be called
|
||||
by any extension or application that wishes to abort the process and
|
||||
have a panic message displayed the same way that panic messages from Tcl
|
||||
will be displayed.
|
||||
.PP
|
||||
\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of
|
||||
taking a variable number of arguments it takes an argument list.
|
||||
.SH "SEE ALSO"
|
||||
abort(3), printf(3), exec(n), format(n)
|
||||
.SH KEYWORDS
|
||||
|
||||
+19
-5
@@ -8,7 +8,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
|
||||
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -33,16 +33,20 @@ const char *
|
||||
.sp
|
||||
\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
|
||||
.sp
|
||||
Tcl_Obj *
|
||||
\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
|
||||
.sp
|
||||
int
|
||||
\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_Interp *usedParsePtr out
|
||||
.AP Tcl_Interp *interp out
|
||||
For procedures other than \fBTcl_FreeParse\fR and
|
||||
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
|
||||
For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
|
||||
and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
|
||||
if NULL, then no error messages are left after errors.
|
||||
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
|
||||
the script and also is used for error reporting; must not be NULL.
|
||||
For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
|
||||
determines the context for evaluating the
|
||||
script and also is used for error reporting; must not be NULL.
|
||||
.AP "const char" *start in
|
||||
Pointer to first character in string to parse.
|
||||
.AP int numBytes in
|
||||
@@ -187,6 +191,16 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
|
||||
some other integer value originating in an extension.
|
||||
In addition, a result value or error message is left in \fIinterp\fR's
|
||||
result; it can be retrieved using \fBTcl_GetObjResult\fR.
|
||||
.PP
|
||||
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
|
||||
the return convention used: it returns the result in a new Tcl_Obj.
|
||||
The reference count of the value returned as result has been
|
||||
incremented, so the caller must
|
||||
invoke \fBTcl_DecrRefCount\fR when it is finished with the value.
|
||||
If an error or other exception occurs while evaluating the tokens
|
||||
(such as a reference to a non-existent variable) then the return value
|
||||
is NULL and an error message is left in \fIinterp\fR's result. The use
|
||||
of \fBTcl_EvalTokens\fR is deprecated.
|
||||
.SH "TCL_PARSE STRUCTURE"
|
||||
.PP
|
||||
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
|
||||
|
||||
+7
-2
@@ -18,7 +18,10 @@ Tcl_PrintDouble \- Convert floating value to string
|
||||
.SH ARGUMENTS
|
||||
.AS Tcl_Interp *interp out
|
||||
.AP Tcl_Interp *interp in
|
||||
This argument is ignored.
|
||||
Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter
|
||||
controlled the conversion. As of Tcl 8.0, this argument is ignored and
|
||||
the conversion is controlled by the \fBtcl_precision\fR variable
|
||||
that is now shared by all interpreters.
|
||||
.AP double value in
|
||||
Floating-point value to be converted.
|
||||
.AP char *dst out
|
||||
@@ -38,7 +41,9 @@ so that it does not look like an integer. Where \fB%g\fR would
|
||||
generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds
|
||||
.QW .0 .
|
||||
.PP
|
||||
The result will have the fewest digits needed to
|
||||
If the \fBtcl_precision\fR value is non-zero, the result will have
|
||||
precisely that many digits of significance. If the value is zero
|
||||
(the default), the result will have the fewest digits needed to
|
||||
represent the number in such a way that \fBTcl_NewDoubleObj\fR
|
||||
will generate the same number when presented with the given string.
|
||||
IEEE semantics of rounding to even apply to the conversion.
|
||||
|
||||
+1
-1
@@ -31,7 +31,7 @@ the command at global level instead of the current stack level.
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
|
||||
on the history list and then execute it using \fBTcl_EvalObjEx\fR.
|
||||
on the history list and then execute it using \fBTcl_EvalObjEx\fR
|
||||
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
|
||||
as well as a result value containing additional information
|
||||
(a result value or error message)
|
||||
|
||||
+1
-1
@@ -29,7 +29,7 @@ New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
|
||||
.PP
|
||||
At any given time Tcl enforces a limit on the number of recursive
|
||||
calls that may be active for \fBTcl_Eval\fR and related procedures
|
||||
such as \fBTcl_EvalEx\fR.
|
||||
such as \fBTcl_GlobalEval\fR.
|
||||
Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with
|
||||
an error.
|
||||
By default the recursion limit is 1000.
|
||||
|
||||
+19
-1
@@ -9,7 +9,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result
|
||||
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -26,6 +26,8 @@ const char *
|
||||
.sp
|
||||
\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR)
|
||||
.sp
|
||||
\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR)
|
||||
.sp
|
||||
\fBTcl_ResetResult\fR(\fIinterp\fR)
|
||||
.sp
|
||||
.VS 8.6
|
||||
@@ -150,6 +152,9 @@ extensions.
|
||||
Any number of \fIresult\fR arguments may be passed in a single
|
||||
call; the last argument in the list must be a NULL pointer.
|
||||
.PP
|
||||
\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
|
||||
instead of taking a variable number of arguments it takes an argument list.
|
||||
.PP
|
||||
.VS 8.6
|
||||
\fBTcl_TransferResult\fR moves a result from one interpreter to another,
|
||||
optionally (dependent on the \fIresult\fR parameter) including the error
|
||||
@@ -192,6 +197,19 @@ It also sets \fIinterp->freeProc\fR to zero, but does not
|
||||
change \fIinterp->result\fR or clear error state.
|
||||
\fBTcl_FreeResult\fR is most commonly used when a procedure
|
||||
is about to replace one result value with another.
|
||||
.SS "DIRECT ACCESS TO INTERP->RESULT"
|
||||
.PP
|
||||
It used to be legal for programs to
|
||||
directly read and write \fIinterp->result\fR
|
||||
to manipulate the interpreter result. The Tcl headers no longer
|
||||
permit this access by default, and C code still doing this must
|
||||
be updated to use supported routines \fBTcl_GetObjResult\fR,
|
||||
\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR.
|
||||
As a migration aid, access can be restored with the compiler directive
|
||||
.CS
|
||||
#define USE_INTERP_RESULT
|
||||
.CE
|
||||
but this is meant only to offer life support to otherwise dead code.
|
||||
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
|
||||
.PP
|
||||
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
|
||||
|
||||
+8
-1
@@ -8,7 +8,7 @@
|
||||
.so man.macros
|
||||
.BS
|
||||
.SH NAME
|
||||
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
|
||||
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
\fB#include <tcl.h>\fR
|
||||
@@ -59,6 +59,9 @@ void
|
||||
\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR)
|
||||
.sp
|
||||
void
|
||||
\fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR)
|
||||
.sp
|
||||
Tcl_Obj *
|
||||
@@ -244,6 +247,10 @@ values may contain internal null characters). Any number of
|
||||
\fIstring\fR arguments may be provided, but the last argument
|
||||
must be a NULL pointer to indicate the end of the list.
|
||||
.PP
|
||||
\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR
|
||||
except that instead of taking a variable number of arguments it takes an
|
||||
argument list.
|
||||
.PP
|
||||
\fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR
|
||||
except that it imposes a limit on how many bytes are appended.
|
||||
This can be handy when the string to be appended might be
|
||||
|
||||
+60
@@ -0,0 +1,60 @@
|
||||
'\"
|
||||
'\" Copyright (c) 1993 The Regents of the University of California.
|
||||
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH case n 7.0 Tcl "Tcl Built-In Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
case \- Evaluate one of several scripts, depending on a given value
|
||||
.SH SYNOPSIS
|
||||
\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...?
|
||||
.sp
|
||||
\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?}
|
||||
.BE
|
||||
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
\fINote: the \fBcase\fI command is obsolete and is supported only
|
||||
for backward compatibility. At some point in the future it may be
|
||||
removed entirely. You should use the \fBswitch\fI command instead.\fR
|
||||
.PP
|
||||
The \fBcase\fR command matches \fIstring\fR against each of
|
||||
the \fIpatList\fR arguments in order.
|
||||
Each \fIpatList\fR argument is a list of one or
|
||||
more patterns. If any of these patterns matches \fIstring\fR then
|
||||
\fBcase\fR evaluates the following \fIbody\fR argument
|
||||
by passing it recursively to the Tcl interpreter and returns the result
|
||||
of that evaluation.
|
||||
Each \fIpatList\fR argument consists of a single
|
||||
pattern or list of patterns. Each pattern may contain any of the wild-cards
|
||||
described under \fBstring match\fR. If a \fIpatList\fR
|
||||
argument is \fBdefault\fR, the corresponding body will be evaluated
|
||||
if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument
|
||||
matches \fIstring\fR and no default is given, then the \fBcase\fR
|
||||
command returns an empty string.
|
||||
.PP
|
||||
Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments.
|
||||
The first uses a separate argument for each of the patterns and commands;
|
||||
this form is convenient if substitutions are desired on some of the
|
||||
patterns or commands.
|
||||
The second form places all of the patterns and commands together into
|
||||
a single argument; the argument must have proper list structure, with
|
||||
the elements of the list being the patterns and commands.
|
||||
The second form makes it easy to construct multi-line case commands,
|
||||
since the braces around the whole list make it unnecessary to include a
|
||||
backslash at the end of each line.
|
||||
Since the \fIpatList\fR arguments are in braces in the second form,
|
||||
no command or variable substitutions are performed on them; this makes
|
||||
the behavior of the second form different than the first form in some
|
||||
cases.
|
||||
|
||||
.SH "SEE ALSO"
|
||||
switch(n)
|
||||
|
||||
.SH KEYWORDS
|
||||
case, match, regular expression
|
||||
+124
-37
@@ -82,17 +82,14 @@ by a superclass; subclass exports override superclass visibility, and may in
|
||||
turn be overridden by instances.
|
||||
.TP
|
||||
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates the list of method names that are used to guard whether
|
||||
method call to instances of the class may be called and what the method's
|
||||
results are. Each \fImethodName\fR names a single filtering method (which may
|
||||
be exposed or not exposed); it is not an error for a non-existent method to be
|
||||
named since they may be defined by subclasses.
|
||||
.VS
|
||||
By default, this slot works by appending.
|
||||
.VE
|
||||
.TP
|
||||
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
|
||||
.
|
||||
@@ -105,6 +102,13 @@ fully-qualified, the command will be searched for in each object's namespace,
|
||||
using the instances' namespace's path, or by looking in the global namespace.
|
||||
The method will be exported if \fIname\fR starts with a lower-case letter, and
|
||||
non-exported otherwise.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private forwarded methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmethod\fI name argList bodyScript\fR
|
||||
.
|
||||
@@ -117,17 +121,40 @@ be a namespace that is unique to the current object. The method will be
|
||||
exported if \fIname\fR starts with a lower-case letter, and non-exported
|
||||
otherwise; this behavior can be overridden via \fBexport\fR and
|
||||
\fBunexport\fR.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private procedure-like methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates the list of additional classes that are to be mixed into
|
||||
all the instances of the class being defined. Each \fIclassName\fR argument
|
||||
names a single class that is to be mixed in.
|
||||
.VS
|
||||
By default, this slot works by replacement.
|
||||
.VE
|
||||
.TP
|
||||
\fBprivate \fIcmd arg...\fR
|
||||
.TP
|
||||
\fBprivate \fIscript\fR
|
||||
.
|
||||
.VS TIP500
|
||||
This evaluates the \fIscript\fR (or the list of command and arguments given by
|
||||
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
|
||||
current class will be private definitions.
|
||||
.RS
|
||||
.PP
|
||||
The following class definition commands are affected by \fBprivate\fR:
|
||||
\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
|
||||
\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
|
||||
definition context is just a private definition context. All other definition
|
||||
commands have no difference in behavior when used in a private definition
|
||||
context.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fBrenamemethod\fI fromName toName\fR
|
||||
.
|
||||
@@ -159,21 +186,23 @@ operates identically to
|
||||
If no arguments at all are used, this gives the name of the class currently
|
||||
being configured.
|
||||
.VE TIP470
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), the definitions on the class object will also be made in a private
|
||||
definition context.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
allows the alteration of the superclasses of the class being defined.
|
||||
Each \fIclassName\fR argument names one class that is to be a superclass of
|
||||
the defined class. Note that objects must not be changed from being classes to
|
||||
being non-classes or vice-versa, that an empty parent class is equivalent to
|
||||
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
|
||||
\fBoo::class\fR may not be modified.
|
||||
.VS
|
||||
By default, this slot works by replacement.
|
||||
.VE
|
||||
.TP
|
||||
\fBunexport\fI name \fR?\fIname ...\fR?
|
||||
.
|
||||
@@ -185,18 +214,31 @@ actually defined by a superclass; subclass unexports override superclass
|
||||
visibility, and may be overridden by instance unexports.
|
||||
.TP
|
||||
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
|
||||
variables to be automatically made
|
||||
available in the methods, constructor and destructor declared by the class
|
||||
being defined. Each variable name must not have any namespace
|
||||
separators and must not look like an array access. All variables will be
|
||||
actually present in the instance object on which the method is executed. Note
|
||||
actually present in the namespace of the instance object on which the method
|
||||
is executed. Note
|
||||
that the variable lists declared by a superclass or subclass are completely
|
||||
disjoint, as are variable lists declared by instances; the list of variable
|
||||
names is just for methods (and constructors and destructors) declared by this
|
||||
class. By default, this slot works by appending.
|
||||
.VE
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this slot manipulates the list of private variable bindings for this
|
||||
class. In a private variable binding, the name of the variable within the
|
||||
instance object is different to the name given in the definition; the name
|
||||
used in the definition is the name that you use to access the variable within
|
||||
the methods of this class, and the name of the variable in the instance
|
||||
namespace has a unique prefix that makes accidental use from other classes
|
||||
extremely unlikely.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.SS "CONFIGURING OBJECTS"
|
||||
.PP
|
||||
The following commands are supported in the \fIdefScript\fR for
|
||||
@@ -223,18 +265,15 @@ being defined. Note that the methods themselves may be actually defined by a
|
||||
class or superclass; object exports override class visibility.
|
||||
.TP
|
||||
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates the list of method names that are used to guard whether a
|
||||
method call to the object may be called and what the method's results are.
|
||||
Each \fImethodName\fR names a single filtering method (which may be exposed or
|
||||
not exposed); it is not an error for a non-existent method to be named. Note
|
||||
that the actual list of filters also depends on the filters set upon any
|
||||
classes that the object is an instance of.
|
||||
.VS
|
||||
By default, this slot works by appending.
|
||||
.VE
|
||||
.TP
|
||||
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
|
||||
.
|
||||
@@ -244,6 +283,13 @@ additional arguments, \fIarg\fR etc., added before those arguments specified
|
||||
by the caller of the method. Forwarded methods should be deleted using the
|
||||
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
|
||||
a lower-case letter, and non-exported otherwise.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private forwarded methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmethod\fI name argList bodyScript\fR
|
||||
.
|
||||
@@ -254,17 +300,38 @@ method will be \fIbodyScript\fR. When the body of the method is evaluated, the
|
||||
current namespace of the method will be a namespace that is unique to the
|
||||
object. The method will be exported if \fIname\fR starts with a lower-case
|
||||
letter, and non-exported otherwise.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this command creates private procedure-like methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.TP
|
||||
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below)
|
||||
.VE
|
||||
sets or updates a per-object list of additional classes that are to be
|
||||
mixed into the object. Each argument, \fIclassName\fR, names a single class
|
||||
that is to be mixed in.
|
||||
.VS
|
||||
By default, this slot works by replacement.
|
||||
.VE
|
||||
.TP
|
||||
\fBprivate \fIcmd arg...\fR
|
||||
.TP
|
||||
\fBprivate \fIscript\fR
|
||||
.VS TIP500
|
||||
This evaluates the \fIscript\fR (or the list of command and arguments given by
|
||||
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
|
||||
current object will be private definitions.
|
||||
.RS
|
||||
.PP
|
||||
The following class definition commands are affected by \fBprivate\fR:
|
||||
\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
|
||||
\fBprivate\fR has no cumulative effect; the innermost definition context is
|
||||
just a private definition context. All other definition commands have no
|
||||
difference in behavior when used in a private definition context.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fBrenamemethod\fI fromName toName\fR
|
||||
.
|
||||
@@ -275,7 +342,6 @@ that the object is an instance of. Does not change the export status of the
|
||||
method; if it was exported before, it will be afterwards.
|
||||
.TP
|
||||
\fBself \fR
|
||||
.
|
||||
.VS TIP470
|
||||
This gives the name of the object currently being configured.
|
||||
.VE TIP470
|
||||
@@ -289,15 +355,42 @@ object being defined. Note that the methods themselves may be actually defined
|
||||
by a class; instance unexports override class visibility.
|
||||
.TP
|
||||
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
|
||||
.VS
|
||||
.
|
||||
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
|
||||
variables to be automatically made available in the methods declared by the
|
||||
object being defined. Each variable name must not have any namespace
|
||||
separators and must not look like an array access. All variables will be
|
||||
actually present in the object on which the method is executed. Note that the
|
||||
actually present in the namespace of the object on which the method is
|
||||
executed. Note that the
|
||||
variable lists declared by the classes and mixins of which the object is an
|
||||
instance are completely disjoint; the list of variable names is just for
|
||||
methods declared by this object. By default, this slot works by appending.
|
||||
.RS
|
||||
.PP
|
||||
.VS TIP500
|
||||
If in a private definition context (see the \fBprivate\fR definition command,
|
||||
below), this slot manipulates the list of private variable bindings for this
|
||||
object. In a private variable binding, the name of the variable within the
|
||||
instance object is different to the name given in the definition; the name
|
||||
used in the definition is the name that you use to access the variable within
|
||||
the methods of this instance object, and the name of the variable in the
|
||||
instance namespace has a unique prefix that makes accidental use from
|
||||
superclass methods extremely unlikely.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.SH "PRIVATE METHODS"
|
||||
.VS TIP500
|
||||
When a class or instance has a private method, that private method can only be
|
||||
invoked from within methods of that class or instance. Other callers of the
|
||||
object's methods \fIcannot\fR invoke private methods, it is as if the private
|
||||
methods do not exist. However, a private method of a class \fIcan\fR be
|
||||
invoked from the class's methods when those methods are being used on another
|
||||
instance object; this means that a class can use them to coordinate behaviour
|
||||
between several instances of itself without interfering with how other
|
||||
classes (especially either subclasses or superclasses) interact. Private
|
||||
methods precede all mixed in classes in the method call order (as reported by
|
||||
\fBself call\fR).
|
||||
.VE TIP500
|
||||
.SH "SLOTTED DEFINITIONS"
|
||||
Some of the configurable definitions of a class or object are \fIslotted
|
||||
definitions\fR. This means that the configuration is implemented by a slot
|
||||
@@ -305,20 +398,17 @@ object, that is an instance of the class \fBoo::Slot\fR, which manages a list
|
||||
of values (class names, variable names, etc.) that comprises the contents of
|
||||
the slot. The class defines three operations (as methods) that may be done on
|
||||
the slot:
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
|
||||
.VS
|
||||
.
|
||||
This appends the given \fImember\fR elements to the slot definition.
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fB\-clear\fR
|
||||
.VS
|
||||
.
|
||||
This sets the slot definition to the empty list.
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
|
||||
.VS
|
||||
.
|
||||
This replaces the slot definition with the given \fImember\fR elements.
|
||||
.PP
|
||||
A consequence of this is that any use of a slot's default operation where the
|
||||
@@ -331,17 +421,15 @@ which is forwarded to the default operation of the slot (thus, for the class
|
||||
slot, this is forwarded to
|
||||
.QW "\fBmy \-append\fR" ),
|
||||
and these methods which provide the implementation interface:
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fBGet\fR
|
||||
.VS
|
||||
.
|
||||
Returns a list that is the current contents of the slot. This method must
|
||||
always be called from a stack frame created by a call to \fBoo::define\fR or
|
||||
\fBoo::objdefine\fR.
|
||||
.VE
|
||||
.TP
|
||||
\fIslot\fR \fBSet \fIelementList\fR
|
||||
.VS
|
||||
.
|
||||
Sets the contents of the slot to the list \fIelementList\fR and returns the
|
||||
empty string. This method must always be called from a stack frame created by
|
||||
a call to \fBoo::define\fR or \fBoo::objdefine\fR.
|
||||
@@ -352,7 +440,6 @@ an unknown method handler to tie all these pieces together, and they hide
|
||||
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
|
||||
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
|
||||
defining new operations whose names start with a hyphen.
|
||||
.VE
|
||||
.SH EXAMPLES
|
||||
This example demonstrates how to use both forms of the \fBoo::define\fR and
|
||||
\fBoo::objdefine\fR commands (they work in the same way), as well as
|
||||
|
||||
+3
-1
@@ -50,7 +50,9 @@ An integer operand may be specified in decimal (the normal case, the optional
|
||||
first two characters are \fB0d\fR), binary
|
||||
(the first two characters are \fB0b\fR), octal
|
||||
(the first two characters are \fB0o\fR), or hexadecimal
|
||||
(the first two characters are \fB0x\fR) form.
|
||||
(the first two characters are \fB0x\fR) form. For
|
||||
compatibility with older Tcl releases, an operand that begins with \fB0\fR is
|
||||
interpreted as an octal integer even if the second character is not \fBo\fR.
|
||||
A floating-point number may be specified in any of several
|
||||
common decimal formats, and may use the decimal point \fB.\fR,
|
||||
\fBe\fR or \fBE\fR for scientific notation, and
|
||||
|
||||
+152
-98
@@ -35,10 +35,9 @@ Returns the body of procedure \fIprocname\fR. \fIProcname\fR must be
|
||||
the name of a Tcl command procedure.
|
||||
.TP
|
||||
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
|
||||
.VS 8.6
|
||||
.
|
||||
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
|
||||
described in \fBCLASS INTROSPECTION\fR below.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo cmdcount\fR
|
||||
.
|
||||
@@ -78,11 +77,10 @@ command is not complete, the script can delay evaluating it until additional
|
||||
lines have been typed to complete the command.
|
||||
.TP
|
||||
\fBinfo coroutine\fR
|
||||
.VS 8.6
|
||||
.
|
||||
Returns the name of the currently executing \fBcoroutine\fR, or the empty
|
||||
string if either no coroutine is currently executing, or the current coroutine
|
||||
has been deleted (but has not yet returned or yielded since deletion).
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo default \fIprocname arg varname\fR
|
||||
.
|
||||
@@ -93,7 +91,7 @@ Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
|
||||
into variable \fIvarname\fR.
|
||||
.TP
|
||||
\fBinfo errorstack \fR?\fIinterp\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
Returns, in a form that is programmatically easy to parse, the function names
|
||||
and arguments at each level from the call stack of the last error in the given
|
||||
\fIinterp\fR, or in the current one if not specified.
|
||||
@@ -118,7 +116,6 @@ options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
|
||||
is a convenient way of retrieving it for uncaught errors at top-level in an
|
||||
interactive \fBtclsh\fR.
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo exists \fIvarName\fR
|
||||
.
|
||||
@@ -329,10 +326,9 @@ was invoked. If Tcl was unable to identify the file, then an empty
|
||||
string is returned.
|
||||
.TP
|
||||
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
|
||||
.VS 8.6
|
||||
.
|
||||
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
|
||||
described in \fBOBJECT INTROSPECTION\fR below.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo patchlevel\fR
|
||||
.
|
||||
@@ -399,20 +395,22 @@ Note that a currently-visible variable may not yet
|
||||
if it has not
|
||||
been set (e.g. a variable declared but not set by \fBvariable\fR).
|
||||
.SS "CLASS INTROSPECTION"
|
||||
.VS 8.6
|
||||
.PP
|
||||
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class call\fI class method\fR
|
||||
.VS
|
||||
.
|
||||
Returns a description of the method implementations that are used to provide a
|
||||
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
|
||||
(stereotypical instances being objects instantiated by a class without having
|
||||
any object-specific definitions added). This consists of a list of lists of
|
||||
four elements, where each sublist consists of a word that describes the
|
||||
general type of method implementation (being one of \fBmethod\fR for an
|
||||
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
|
||||
ordinary method, \fBfilter\fR for an applied filter,
|
||||
.VS TIP500
|
||||
\fBprivate\fR for a private method,
|
||||
.VE TIP500
|
||||
and \fBunknown\fR for a
|
||||
method that is invoked as part of unknown method handling), a word giving the
|
||||
name of the particular method invoked (which is always the same as
|
||||
\fImethod\fR for the \fBmethod\fR type, and
|
||||
@@ -423,122 +421,149 @@ implementation (see \fBinfo class methodtype\fR).
|
||||
.RS
|
||||
.PP
|
||||
Note that there is no inspection of whether the method implementations
|
||||
actually use \fBnext\fR to transfer control along the call chain.
|
||||
actually use \fBnext\fR to transfer control along the call chain,
|
||||
.VS TIP500
|
||||
and the call chains that this command files do not actually contain private
|
||||
methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class constructor\fI class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a description of the definition of the constructor of
|
||||
class \fIclass\fR. The definition is described as a two element list; the first
|
||||
element is the list of arguments to the constructor in a form suitable for
|
||||
passing to another call to \fBproc\fR or a method definition, and the second
|
||||
element is the body of the constructor. If no constructor is present, this
|
||||
returns the empty list.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class definition\fI class method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a description of the definition of the method named
|
||||
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
|
||||
list; the first element is the list of arguments to the method in a form
|
||||
suitable for passing to another call to \fBproc\fR or a method definition, and
|
||||
the second element is the body of the method.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class destructor\fI class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns the body of the destructor of class \fIclass\fR. If no
|
||||
destructor is present, this returns the empty string.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class filters\fI class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns the list of filter methods set on the class.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class forward\fI class method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns the argument list for the method forwarding called
|
||||
\fImethod\fR that is set on the class called \fIclass\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class instances\fI class\fR ?\fIpattern\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of instances of class \fIclass\fR. If the
|
||||
optional \fIpattern\fR argument is present, it constrains the list of returned
|
||||
instances to those that match it according to the rules of \fBstring match\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of all public (i.e. exported) methods of the
|
||||
class called \fIclass\fR. Any of the following \fIoption\fRs may be
|
||||
specified, controlling exactly which method names are returned:
|
||||
.RS
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-all\fR
|
||||
.VS 8.6
|
||||
If the \fB\-all\fR flag is given, the list of methods will include those
|
||||
.
|
||||
If the \fB\-all\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will include those
|
||||
methods defined not just by the class, but also by the class's superclasses
|
||||
and mixins.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-private\fR
|
||||
.VS 8.6
|
||||
If the \fB\-private\fR flag is given, the list of methods will also include
|
||||
the private (i.e. non-exported) methods of the class (and superclasses and
|
||||
.
|
||||
If the \fB\-private\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will also include
|
||||
the non-exported methods of the class (and superclasses and
|
||||
mixins, if \fB\-all\fR is also given).
|
||||
.VS TIP500
|
||||
Note that this naming is an unfortunate clash with true private methods; this
|
||||
option name is retained for backward compatibility.
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fB\-scope\fI scope\fR
|
||||
.VS TIP500
|
||||
Returns a list of all methods on \fIclass\fR that have the given visibility
|
||||
\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
|
||||
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
|
||||
.RS
|
||||
.IP \fBpublic\fR 3
|
||||
Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
|
||||
of this class) are to be returned.
|
||||
.IP \fBunexported\fR 3
|
||||
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
|
||||
be returned.
|
||||
.IP \fBprivate\fR 3
|
||||
Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
|
||||
methods) are to be returned.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class methodtype\fI class method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a description of the type of implementation used for
|
||||
the method named \fImethod\fR of class \fIclass\fR. When the result is
|
||||
\fBmethod\fR, further information can be discovered with \fBinfo class
|
||||
definition\fR, and when the result is \fBforward\fR, further information can
|
||||
be discovered with \fBinfo class forward\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class mixins\fI class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of all classes that have been mixed into the
|
||||
class named \fIclass\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
|
||||
the optional \fIpattern\fR argument is present, it constrains the list of
|
||||
returned classes to those that match it according to the rules of
|
||||
\fBstring match\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class superclasses\fI class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of direct superclasses of class \fIclass\fR in
|
||||
inheritance precedence order.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo class variables\fI class\fR
|
||||
.VS 8.6
|
||||
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
|
||||
.
|
||||
This subcommand returns a list of all variables that have been declared for
|
||||
the class named \fIclass\fR (i.e. that are automatically present in the
|
||||
class's methods, constructor and destructor).
|
||||
.VS TIP500
|
||||
If the \fB\-private\fR option is specified, this lists the private variables
|
||||
declared instead.
|
||||
.VE TIP500
|
||||
.SS "OBJECT INTROSPECTION"
|
||||
.PP
|
||||
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object call\fI object method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
Returns a description of the method implementations that are used to provide
|
||||
\fIobject\fR's implementation of \fImethod\fR. This consists of a list of
|
||||
lists of four elements, where each sublist consists of a word that describes
|
||||
the general type of method implementation (being one of \fBmethod\fR for an
|
||||
ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
|
||||
ordinary method, \fBfilter\fR for an applied filter,
|
||||
.VS TIP500
|
||||
\fBprivate\fR for a private method,
|
||||
.VE TIP500
|
||||
and \fBunknown\fR for a
|
||||
method that is invoked as part of unknown method handling), a word giving the
|
||||
name of the particular method invoked (which is always the same as
|
||||
\fImethod\fR for the \fBmethod\fR type, and
|
||||
@@ -550,128 +575,160 @@ implementation (see \fBinfo object methodtype\fR).
|
||||
.RS
|
||||
.PP
|
||||
Note that there is no inspection of whether the method implementations
|
||||
actually use \fBnext\fR to transfer control along the call chain.
|
||||
actually use \fBnext\fR to transfer control along the call chain,
|
||||
.VS TIP500
|
||||
and the call chains that this command files do not actually contain private
|
||||
methods.
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object class\fI object\fR ?\fIclassName\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
If \fIclassName\fR is unspecified, this subcommand returns class of the
|
||||
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
|
||||
boolean value indicating whether the \fIobject\fR is of that class.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object creationid\fI object\fR
|
||||
.VS TIP500
|
||||
Returns the unique creation identifier for the \fIobject\fR object. This
|
||||
creation identifier is unique to the object (within a Tcl interpreter) and
|
||||
cannot be controlled at object creation time or altered afterwards.
|
||||
.RS
|
||||
.PP
|
||||
\fIImplementation note:\fR the creation identifier is used to generate unique
|
||||
identifiers associated with the object, especially for private variables.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fBinfo object definition\fI object method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a description of the definition of the method named
|
||||
\fImethod\fR of object \fIobject\fR. The definition is described as a two
|
||||
element list; the first element is the list of arguments to the method in a
|
||||
form suitable for passing to another call to \fBproc\fR or a method definition,
|
||||
and the second element is the body of the method.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object filters\fI object\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns the list of filter methods set on the object.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object forward\fI object method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns the argument list for the method forwarding called
|
||||
\fImethod\fR that is set on the object called \fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa\fI category object\fR ?\fIarg\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand tests whether an object belongs to a particular category,
|
||||
returning a boolean value that indicates whether the \fIobject\fR argument
|
||||
meets the criteria for the category. The supported categories are:
|
||||
.VE 8.6
|
||||
.RS
|
||||
.TP
|
||||
\fBinfo object isa class\fI object\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This returns whether \fIobject\fR is a class (i.e. an instance of
|
||||
\fBoo::class\fR or one of its subclasses).
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa metaclass\fI object\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This returns whether \fIobject\fR is a class that can manufacture classes
|
||||
(i.e. is \fBoo::class\fR or a subclass of it).
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa mixin\fI object class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa object\fI object\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This returns whether \fIobject\fR really is an object.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object isa typeof\fI object class\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
|
||||
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
|
||||
direct or indirect).
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of all public (i.e. exported) methods of the
|
||||
object called \fIobject\fR. Any of the following \fIoption\fRs may be
|
||||
specified, controlling exactly which method names are returned:
|
||||
.RS
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-all\fR
|
||||
.VS 8.6
|
||||
If the \fB\-all\fR flag is given, the list of methods will include those
|
||||
.
|
||||
If the \fB\-all\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will include those
|
||||
methods defined not just by the object, but also by the object's class and
|
||||
mixins, plus the superclasses of those classes.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fB\-private\fR
|
||||
.VS 8.6
|
||||
If the \fB\-private\fR flag is given, the list of methods will also include
|
||||
the private (i.e. non-exported) methods of the object (and classes, if
|
||||
.
|
||||
If the \fB\-private\fR flag is given,
|
||||
.VS TIP500
|
||||
and the \fB\-scope\fR flag is not given,
|
||||
.VE TIP500
|
||||
the list of methods will also include
|
||||
the non-exported methods of the object (and classes, if
|
||||
\fB\-all\fR is also given).
|
||||
.VS TIP500
|
||||
Note that this naming is an unfortunate clash with true private methods; this
|
||||
option name is retained for backward compatibility.
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fB\-scope\fI scope\fR
|
||||
.VS TIP500
|
||||
Returns a list of all methods on \fIobject\fR that have the given visibility
|
||||
\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
|
||||
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
|
||||
.RS
|
||||
.IP \fBpublic\fR 3
|
||||
Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
|
||||
returned.
|
||||
.IP \fBunexported\fR 3
|
||||
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
|
||||
be returned.
|
||||
.IP \fBprivate\fR 3
|
||||
Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
|
||||
instance methods) are to be returned.
|
||||
.RE
|
||||
.VE TIP500
|
||||
.RE
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object methodtype\fI object method\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a description of the type of implementation used for
|
||||
the method named \fImethod\fR of object \fIobject\fR. When the result is
|
||||
\fBmethod\fR, further information can be discovered with \fBinfo object
|
||||
definition\fR, and when the result is \fBforward\fR, further information can
|
||||
be discovered with \fBinfo object forward\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object mixins\fI object\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of all classes that have been mixed into the
|
||||
object named \fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object namespace\fI object\fR
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns the name of the internal namespace of the object named
|
||||
\fIobject\fR.
|
||||
.VE 8.6
|
||||
.TP
|
||||
\fBinfo object variables\fI object\fR
|
||||
.VS 8.6
|
||||
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
|
||||
.
|
||||
This subcommand returns a list of all variables that have been declared for
|
||||
the object named \fIobject\fR (i.e. that are automatically present in the
|
||||
object's methods).
|
||||
.VE 8.6
|
||||
.VS TIP500
|
||||
If the \fB\-private\fR option is specified, this lists the private variables
|
||||
declared instead.
|
||||
.VE TIP500
|
||||
.TP
|
||||
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
|
||||
.VS 8.6
|
||||
.
|
||||
This subcommand returns a list of all variables in the private namespace of
|
||||
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
|
||||
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
|
||||
@@ -680,7 +737,6 @@ from the list returned by \fBinfo object variables\fR; that can include
|
||||
variables that are currently unset, whereas this can include variables that
|
||||
are not automatically included by any of \fIobject\fR's methods (or those of
|
||||
its class, superclasses or mixins).
|
||||
.VE 8.6
|
||||
.SH EXAMPLES
|
||||
.PP
|
||||
This command prints out a procedure suitable for saving in a Tcl
|
||||
@@ -703,7 +759,6 @@ proc printProc {procName} {
|
||||
}
|
||||
.CE
|
||||
.SS "EXAMPLES WITH OBJECTS"
|
||||
.VS 8.6
|
||||
.PP
|
||||
Every object necessarily knows what its class is; this information is
|
||||
trivially extractable through introspection:
|
||||
@@ -724,8 +779,10 @@ method and get how it is defined. This procedure illustrates how:
|
||||
proc getDef {obj method} {
|
||||
foreach inf [\fBinfo object call\fR $obj $method] {
|
||||
lassign $inf calltype name locus methodtype
|
||||
|
||||
# Assume no forwards or filters, and hence no $calltype
|
||||
# or $methodtype checks...
|
||||
|
||||
if {$locus eq "object"} {
|
||||
return [\fBinfo object definition\fR $obj $name]
|
||||
} else {
|
||||
@@ -748,7 +805,9 @@ proc getDef {obj method} {
|
||||
# Assume no forwards
|
||||
return [\fBinfo object definition\fR $obj $method]
|
||||
}
|
||||
|
||||
set cls [\fBinfo object class\fR $obj]
|
||||
|
||||
while {$method ni [\fBinfo class methods\fR $cls]} {
|
||||
# Assume the simple case
|
||||
set cls [lindex [\fBinfo class superclass\fR $cls] 0]
|
||||
@@ -756,22 +815,17 @@ proc getDef {obj method} {
|
||||
error "no definition for $method"
|
||||
}
|
||||
}
|
||||
|
||||
# Assume no forwards
|
||||
return [\fBinfo class definition\fR $cls $method]
|
||||
}
|
||||
.CE
|
||||
.VE 8.6
|
||||
.SH "SEE ALSO"
|
||||
.VS 8.6
|
||||
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
|
||||
.VE 8.6
|
||||
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
|
||||
.SH KEYWORDS
|
||||
command, information, interpreter, introspection, level, namespace,
|
||||
.VS 8.6
|
||||
object,
|
||||
.VE 8.6
|
||||
procedure, variable
|
||||
object, procedure, variable
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" fill-column: 78
|
||||
|
||||
+4
-1
@@ -106,7 +106,10 @@ of which work solely with floating-point numbers unless otherwise noted:
|
||||
In addition to these predefined functions, applications may
|
||||
define additional functions by using \fBproc\fR (or any other method,
|
||||
such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
|
||||
new commands in the \fBtcl::mathfunc\fR namespace.
|
||||
new commands in the \fBtcl::mathfunc\fR namespace. In addition, an
|
||||
obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
|
||||
extensions that are written in C. The latter interface is not recommended
|
||||
for new implementations.
|
||||
.SS "DETAILED DEFINITIONS"
|
||||
.TP
|
||||
\fBabs \fIarg\fR
|
||||
|
||||
@@ -19,13 +19,18 @@ package require TclOO
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
The \fBmy\fR command is used to allow methods of objects to invoke any method
|
||||
The \fBmy\fR command is used to allow methods of objects to invoke methods
|
||||
of the object (or its class). In particular, the set of valid values for
|
||||
\fImethodName\fR is the set of all methods supported by an object and its
|
||||
superclasses, including those that are not exported. The object upon which the
|
||||
method is invoked is always the one that is the current context of the method
|
||||
(i.e. the object that is returned by \fBself object\fR) from which the
|
||||
\fBmy\fR command is invoked.
|
||||
superclasses, including those that are not exported
|
||||
.VS TIP500
|
||||
and private methods of the object or class when used within another method
|
||||
defined by that object or class.
|
||||
.VE TIP500
|
||||
The object upon which the method is invoked is the one that owns the namespace
|
||||
that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
|
||||
remains if the command is renamed), which is the currently invoked object by
|
||||
default.
|
||||
.PP
|
||||
Each object has its own \fBmy\fR command, contained in its instance namespace.
|
||||
.SH EXAMPLES
|
||||
@@ -40,16 +45,38 @@ oo::class create c {
|
||||
puts [incr counter]
|
||||
}
|
||||
}
|
||||
|
||||
c create o
|
||||
o count \fI\(-> prints "1"\fR
|
||||
o count \fI\(-> prints "2"\fR
|
||||
o count \fI\(-> prints "3"\fR
|
||||
.CE
|
||||
.PP
|
||||
This example shows how you can use \fBmy\fR to make callbacks to private
|
||||
methods from outside the object (from a \fBtrace\fR), using
|
||||
\fBnamespace code\fR to enter the correct context:
|
||||
.PP
|
||||
.CS
|
||||
oo::class create HasCallback {
|
||||
method makeCallback {} {
|
||||
return [namespace code {
|
||||
\fBmy\fR Callback
|
||||
}]
|
||||
}
|
||||
|
||||
method Callback {args} {
|
||||
puts "callback: $args"
|
||||
}
|
||||
}
|
||||
|
||||
set o [HasCallback new]
|
||||
trace add variable xyz write [$o makeCallback]
|
||||
set xyz "called" \fI\(-> prints "callback: xyz {} write"\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
next(n), oo::object(n), self(n)
|
||||
.SH KEYWORDS
|
||||
method, method visibility, object, private method, public method
|
||||
|
||||
.\" Local variables:
|
||||
.\" mode: nroff
|
||||
.\" fill-column: 78
|
||||
|
||||
@@ -112,6 +112,7 @@ oo::class create theSuperclass {
|
||||
puts "in the superclass, args = $args"
|
||||
}
|
||||
}
|
||||
|
||||
oo::class create theSubclass {
|
||||
superclass theSuperclass
|
||||
method example {args} {
|
||||
@@ -121,6 +122,7 @@ oo::class create theSubclass {
|
||||
puts "after chaining from subclass"
|
||||
}
|
||||
}
|
||||
|
||||
theSubclass create obj
|
||||
oo::objdefine obj method example args {
|
||||
puts "per-object method, args = $args"
|
||||
@@ -167,6 +169,7 @@ oo::class create cache {
|
||||
\fI# Compute value, insert into cache, and return it\fR
|
||||
return [set ValueCache($key) [\fBnext\fR {*}$args]]
|
||||
}
|
||||
|
||||
method flushCache {} {
|
||||
my variable ValueCache
|
||||
unset ValueCache
|
||||
@@ -178,10 +181,12 @@ oo::class create cache {
|
||||
oo::object create demo
|
||||
oo::objdefine demo {
|
||||
mixin cache
|
||||
|
||||
method compute {a b c} {
|
||||
after 3000 \fI;# Simulate deep thought\fR
|
||||
return [expr {$a + $b * $c}]
|
||||
}
|
||||
|
||||
method compute2 {a b c} {
|
||||
after 3000 \fI;# Simulate deep thought\fR
|
||||
return [expr {$a * $b + $c}]
|
||||
|
||||
+131
@@ -0,0 +1,131 @@
|
||||
'\"
|
||||
'\" Copyright (c) 2017 Frederic Bonnet.
|
||||
'\"
|
||||
'\" See the file "license.terms" for information on usage and redistribution
|
||||
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
'\"
|
||||
.TH process n 8.7 Tcl "Tcl Built-In Commands"
|
||||
.so man.macros
|
||||
.BS
|
||||
'\" Note: do not modify the .SH NAME line immediately below!
|
||||
.SH NAME
|
||||
tcl::process \- Subprocess management
|
||||
.SH SYNOPSIS
|
||||
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
|
||||
.BE
|
||||
.SH DESCRIPTION
|
||||
.PP
|
||||
This command provides a way to manage subprocesses created by the \fBopen\fR
|
||||
and \fBexec\fR commands. The legal \fIoptions\fR (which may be abbreviated) are:
|
||||
.TP
|
||||
\fB::tcl::process list\fR
|
||||
.
|
||||
Returns the list of subprocess PIDs.
|
||||
.TP
|
||||
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
|
||||
.
|
||||
Returns a dictionary mapping subprocess PIDs to their respective status. If
|
||||
\fIpids\fR is specified as a list of PIDs then the command only returns the
|
||||
status of the matching subprocesses if they exist, and raises an error
|
||||
otherwise. For active processes, the status is an empty value. For terminated
|
||||
processes, the status is a list with the following format:
|
||||
.QW "{code ?\fImsg errorCode\fR?}" ,
|
||||
where:
|
||||
.RS
|
||||
.TP
|
||||
\fBcode\fR\0
|
||||
.
|
||||
is a standard Tcl return code,
|
||||
.TP
|
||||
\fBmsg\fR\0
|
||||
.
|
||||
is the human-readable error message,
|
||||
.TP
|
||||
\fBerrorCode\fR\0
|
||||
.
|
||||
uses the same format as the \fBerrorCode\fR global variable
|
||||
.RE
|
||||
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
|
||||
terminated processes (i.e. those where \fBcode\fR is nonzero). Under the hood
|
||||
this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
|
||||
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
|
||||
.RS
|
||||
.PP
|
||||
Additionally, \fB::tcl::process status\fR accepts the following switches:
|
||||
.TP
|
||||
\fB\-wait\fR\0
|
||||
.
|
||||
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
|
||||
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fBpids\fR
|
||||
is specified as a list of PIDs then the command waits until the status of the
|
||||
matching subprocesses are available. If \fBpids\fR is not specified then it
|
||||
waits for all known subprocesses.
|
||||
.TP
|
||||
\fB\-\|\-\fR
|
||||
.
|
||||
Marks the end of switches. The argument following this one will
|
||||
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
|
||||
.RE
|
||||
.TP
|
||||
\fB::tcl::process purge ?\fIpids\fR?
|
||||
.
|
||||
Cleans up all data associated with terminated subprocesses. If \fBpids\fR is
|
||||
specified as a list of PIDs then the command only cleanup data for the matching
|
||||
subprocesses if they exist, and raises an error otherwise. If the process is
|
||||
still active then it does nothing.
|
||||
.TP
|
||||
\fB::tcl::process autopurge ?\fIflag\fR?
|
||||
.
|
||||
Automatic purge facility. If \fBflag\fR is specified as a boolean value then it
|
||||
activates or deactivate autopurge. In all cases it returns the current status as
|
||||
a boolean value. When autopurge is active, \fBTcl_ReapDetachedProcs\fR is called
|
||||
each time the exec command is executed or a pipe channel created by open is
|
||||
closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called
|
||||
explicitly. By default autopurge is active.
|
||||
.RE
|
||||
.SH "EXAMPLES"
|
||||
.PP
|
||||
.CS
|
||||
\fB::tcl::process autopurge\fR
|
||||
\fI\(-> true\fR
|
||||
\fB::tcl::process autopurge\fR false
|
||||
\fI\(-> false\fR
|
||||
|
||||
set pid1 [exec command1 a b c | command2 d e f &]
|
||||
\fI\(-> 123 456\fR
|
||||
set chan [open "|command1 a b c | command2 d e f"]
|
||||
\fI\(-> file123\fR
|
||||
set pid2 [pid $chan]
|
||||
\fI\(-> 789 1011\fR
|
||||
|
||||
\fB::tcl::process list\fR
|
||||
\fI\(-> 123 456 789 1011\fR
|
||||
|
||||
\fB::tcl::process status\fR
|
||||
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {}\fR
|
||||
|
||||
\fB::tcl::process status\fR 123
|
||||
\fI\(-> 123 0\fR
|
||||
|
||||
\fB::tcl::process status\fR 1011
|
||||
\fI\(-> 1011 {}\fR
|
||||
|
||||
\fB::tcl::process status\fR -wait
|
||||
\fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
|
||||
|
||||
\fB::tcl::process status\fR 1011
|
||||
\fI\(-> 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
|
||||
|
||||
\fB::tcl::process purge\fR
|
||||
exec command1 1 2 3 &
|
||||
\fI\(-> 1213\fR
|
||||
\fB::tcl::process list\fR
|
||||
\fI\(-> 1213\fR
|
||||
.CE
|
||||
.SH "SEE ALSO"
|
||||
exec(n), open(n), Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
|
||||
.SH "KEYWORDS"
|
||||
background, child, detach, process, wait
|
||||
'\" Local Variables:
|
||||
'\" mode: nroff
|
||||
'\" End:
|
||||
+4
-2
@@ -224,10 +224,12 @@ set string "#08D03F"
|
||||
\fBscan\fR $string "#%2x%2x%2x" r g b
|
||||
.CE
|
||||
.PP
|
||||
Parse a \fIHH:MM\fR time string:
|
||||
Parse a \fIHH:MM\fR time string, noting that this avoids problems with
|
||||
octal numbers by forcing interpretation as decimals (if we did not
|
||||
care, we would use the \fB%i\fR conversion instead):
|
||||
.PP
|
||||
.CS
|
||||
set string "08:08"
|
||||
set string "08:08" ;# *Not* octal!
|
||||
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
|
||||
error "not a valid time string"
|
||||
}
|
||||
|
||||
+6
-1
@@ -32,7 +32,12 @@ implement the current call chain. The first element is the same as would be
|
||||
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
|
||||
also reports useful values from within constructors and destructors, whose
|
||||
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
|
||||
respectively), and the second element is an index into the first element's
|
||||
respectively,
|
||||
.VS TIP500
|
||||
and for private methods, which are described as being \fBprivate\fR instead of
|
||||
being a \fBmethod\fR),
|
||||
.VE TIP500
|
||||
and the second element is an index into the first element's
|
||||
list that indicates which actual implementation is currently executing (the
|
||||
first implementation to execute is always at index 0).
|
||||
.TP
|
||||
|
||||
+65
-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_rcFileName, tcl_traceCompile, tcl_traceExec, 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
|
||||
@@ -356,6 +356,70 @@ This gives the size of the native-machine word in bytes (strictly, it
|
||||
is same as the result of evaluating \fIsizeof(long)\fR in C.)
|
||||
.RE
|
||||
.TP
|
||||
\fBtcl_precision\fR
|
||||
.
|
||||
This variable controls the number of digits to generate
|
||||
when converting floating-point values to strings. It defaults
|
||||
to 0. \fIApplications should not change this value;\fR it is
|
||||
provided for compatibility with legacy code.
|
||||
.PP
|
||||
.RS
|
||||
The default value of 0 is special, meaning that Tcl should
|
||||
convert numbers using as few digits as possible while still
|
||||
distinguishing any floating point number from its nearest
|
||||
neighbours. It differs from using an arbitrarily high value
|
||||
for \fItcl_precision\fR in that an inexact number like \fI1.4\fR
|
||||
will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR
|
||||
even though the latter is nearer to the exact value of the
|
||||
binary number.
|
||||
.RE
|
||||
.PP
|
||||
.RS
|
||||
If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
|
||||
point number, it creates a decimal representation of at most
|
||||
\fBtcl_precision\fR significant digits; the result may be shorter if
|
||||
the shorter result represents the original number exactly. If no
|
||||
result of at most \fBtcl_precision\fR digits is an exact representation
|
||||
of the original number, the one that is closest to the original
|
||||
number is chosen.
|
||||
If the original number lies precisely between two equally accurate
|
||||
decimal representations, then the one with an even value for the least
|
||||
significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then
|
||||
0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to
|
||||
0.688, not 0.687. Any string of trailing zeroes that remains is trimmed.
|
||||
.RE
|
||||
.PP
|
||||
.RS
|
||||
a \fBtcl_precision\fR value of 17 digits is
|
||||
.QW perfect
|
||||
for IEEE floating-point in that it allows
|
||||
double-precision values to be converted to strings and back to
|
||||
binary with no loss of information. For this reason, you will often
|
||||
see it as a value in legacy code that must run on Tcl versions before
|
||||
8.5. It is no longer recommended; as noted above, a zero value is the
|
||||
preferred method.
|
||||
.RE
|
||||
.PP
|
||||
.RS
|
||||
All interpreters in a thread share a single \fBtcl_precision\fR value:
|
||||
changing it in one interpreter will affect all other interpreters as
|
||||
well. Safe interpreters are not allowed to modify the
|
||||
variable.
|
||||
.RE
|
||||
.PP
|
||||
.RS
|
||||
Valid values for \fBtcl_precision\fR range from 0 to 17.
|
||||
.RE
|
||||
.TP
|
||||
\fBtcl_rcFileName\fR
|
||||
.
|
||||
This variable is used during initialization to indicate the name of a
|
||||
user-specific startup file. If it is set by application-specific
|
||||
initialization, then the Tcl startup code will check for the existence
|
||||
of this file and \fBsource\fR it if it exists. For example, for \fBwish\fR
|
||||
the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR
|
||||
for Windows.
|
||||
.TP
|
||||
\fBtcl_traceCompile\fR
|
||||
.
|
||||
The value of this variable can be set to control
|
||||
|
||||
+91
-114
@@ -104,10 +104,9 @@ declare 20 {
|
||||
declare 21 {
|
||||
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 22 {
|
||||
# Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
|
||||
#}
|
||||
declare 22 {
|
||||
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
|
||||
}
|
||||
declare 23 {
|
||||
Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
|
||||
const char *file, int line)
|
||||
@@ -120,10 +119,9 @@ declare 25 {
|
||||
Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
|
||||
const char *file, int line)
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 26 {
|
||||
# Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
|
||||
#}
|
||||
declare 26 {
|
||||
Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
|
||||
}
|
||||
declare 27 {
|
||||
Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
|
||||
}
|
||||
@@ -168,7 +166,7 @@ declare 39 {
|
||||
int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
|
||||
}
|
||||
declare 40 {
|
||||
const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
|
||||
CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName)
|
||||
}
|
||||
declare 41 {
|
||||
char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
|
||||
@@ -200,37 +198,33 @@ declare 48 {
|
||||
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
|
||||
int count, int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 49 {
|
||||
# Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
|
||||
#}
|
||||
declare 49 {
|
||||
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
|
||||
}
|
||||
declare 50 {
|
||||
Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
|
||||
}
|
||||
declare 51 {
|
||||
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 52 {
|
||||
# Tcl_Obj *Tcl_NewIntObj(int intValue)
|
||||
#}
|
||||
declare 52 {
|
||||
Tcl_Obj *Tcl_NewIntObj(int intValue)
|
||||
}
|
||||
declare 53 {
|
||||
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 54 {
|
||||
# Tcl_Obj *Tcl_NewLongObj(long longValue)
|
||||
#}
|
||||
declare 54 {
|
||||
Tcl_Obj *Tcl_NewLongObj(long longValue)
|
||||
}
|
||||
declare 55 {
|
||||
Tcl_Obj *Tcl_NewObj(void)
|
||||
}
|
||||
declare 56 {
|
||||
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 57 {
|
||||
# void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
|
||||
#}
|
||||
declare 57 {
|
||||
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
|
||||
}
|
||||
declare 58 {
|
||||
unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length)
|
||||
}
|
||||
@@ -241,17 +235,15 @@ declare 59 {
|
||||
declare 60 {
|
||||
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 61 {
|
||||
# void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
|
||||
#}
|
||||
declare 61 {
|
||||
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
|
||||
}
|
||||
declare 62 {
|
||||
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
|
||||
}
|
||||
# Removed in 9.0 (changed to macro):
|
||||
#declare 63 {
|
||||
# void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
|
||||
#}
|
||||
declare 63 {
|
||||
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
|
||||
}
|
||||
declare 64 {
|
||||
void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
|
||||
}
|
||||
@@ -293,10 +285,9 @@ declare 75 {
|
||||
declare 76 {
|
||||
void Tcl_BackgroundError(Tcl_Interp *interp)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 77 {deprecated {Use Tcl_UtfBackslash}} {
|
||||
# char Tcl_Backslash(const char *src, int *readPtr)
|
||||
#}
|
||||
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
|
||||
char Tcl_Backslash(const char *src, int *readPtr)
|
||||
}
|
||||
declare 78 {
|
||||
int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
|
||||
const char *optionList)
|
||||
@@ -361,12 +352,11 @@ declare 93 {
|
||||
declare 94 {
|
||||
Tcl_Interp *Tcl_CreateInterp(void)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 95 {deprecated {}} {
|
||||
# void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
|
||||
# int numArgs, Tcl_ValueType *argTypes,
|
||||
# Tcl_MathProc *proc, ClientData clientData)
|
||||
#}
|
||||
declare 95 {deprecated {}} {
|
||||
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
|
||||
int numArgs, Tcl_ValueType *argTypes,
|
||||
Tcl_MathProc *proc, ClientData clientData)
|
||||
}
|
||||
declare 96 {
|
||||
Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
@@ -482,10 +472,9 @@ declare 129 {
|
||||
declare 130 {
|
||||
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
|
||||
}
|
||||
# Removed in 9.0, replaced by macro.
|
||||
#declare 131 {
|
||||
# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
#}
|
||||
declare 131 {
|
||||
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 132 {
|
||||
void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
|
||||
}
|
||||
@@ -576,7 +565,7 @@ declare 157 {
|
||||
const char *optionName, Tcl_DString *dsPtr)
|
||||
}
|
||||
declare 158 {
|
||||
const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
|
||||
CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
|
||||
}
|
||||
declare 159 {
|
||||
int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
|
||||
@@ -646,10 +635,9 @@ declare 176 {
|
||||
declare 177 {
|
||||
int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
|
||||
}
|
||||
# Removed in 9.0, replaced by macro.
|
||||
#declare 178 {
|
||||
# int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
#}
|
||||
declare 178 {
|
||||
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 179 {
|
||||
int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
|
||||
const char *hiddenCmdToken)
|
||||
@@ -791,10 +779,9 @@ declare 218 {
|
||||
declare 219 {
|
||||
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 220 {
|
||||
# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
|
||||
#}
|
||||
declare 220 {deprecated {}} {
|
||||
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
|
||||
}
|
||||
declare 221 {
|
||||
int Tcl_ServiceAll(void)
|
||||
}
|
||||
@@ -879,10 +866,9 @@ declare 244 {
|
||||
declare 245 {
|
||||
int Tcl_StringMatch(const char *str, const char *pattern)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 246 {
|
||||
# int Tcl_TellOld(Tcl_Channel chan)
|
||||
#}
|
||||
declare 246 {deprecated {}} {
|
||||
int Tcl_TellOld(Tcl_Channel chan)
|
||||
}
|
||||
declare 247 {
|
||||
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
|
||||
Tcl_VarTraceProc *proc, ClientData clientData)
|
||||
@@ -956,14 +942,12 @@ declare 265 {
|
||||
declare 266 {
|
||||
void Tcl_ValidateAllMemory(const char *file, int line)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 267 {
|
||||
# void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 268 {
|
||||
# void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
|
||||
#}
|
||||
declare 267 {deprecated {see TIP #422}} {
|
||||
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
|
||||
}
|
||||
declare 268 {deprecated {see TIP #422}} {
|
||||
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
|
||||
}
|
||||
declare 269 {
|
||||
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
|
||||
}
|
||||
@@ -989,21 +973,18 @@ declare 274 {
|
||||
const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 275 {
|
||||
# void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 276 {
|
||||
# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
|
||||
#}
|
||||
declare 275 {deprecated {see TIP #422}} {
|
||||
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
|
||||
}
|
||||
declare 276 {deprecated {see TIP #422}} {
|
||||
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
|
||||
}
|
||||
declare 277 {
|
||||
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 278 {
|
||||
# TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
|
||||
#}
|
||||
declare 278 {deprecated {see TIP #422}} {
|
||||
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
|
||||
}
|
||||
declare 279 {
|
||||
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
|
||||
}
|
||||
@@ -1230,14 +1211,12 @@ declare 339 {
|
||||
declare 340 {
|
||||
char *Tcl_GetString(Tcl_Obj *objPtr)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
|
||||
# const char *Tcl_GetDefaultEncodingDir(void)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
|
||||
# void Tcl_SetDefaultEncodingDir(const char *path)
|
||||
#}
|
||||
declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
|
||||
const char *Tcl_GetDefaultEncodingDir(void)
|
||||
}
|
||||
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
|
||||
void Tcl_SetDefaultEncodingDir(const char *path)
|
||||
}
|
||||
declare 343 {
|
||||
void Tcl_AlertNotifier(ClientData clientData)
|
||||
}
|
||||
@@ -1284,11 +1263,10 @@ declare 356 {
|
||||
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
|
||||
int flags)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
|
||||
# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
# int count)
|
||||
#}
|
||||
declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
|
||||
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
|
||||
int count)
|
||||
}
|
||||
declare 358 {
|
||||
void Tcl_FreeParse(Tcl_Parse *parsePtr)
|
||||
}
|
||||
@@ -1512,15 +1490,13 @@ declare 420 {
|
||||
int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
|
||||
const Tcl_UniChar *uniPattern, int nocase)
|
||||
}
|
||||
# Removed in 9.0, as it is actually a macro:
|
||||
#declare 421 {
|
||||
# Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
|
||||
#}
|
||||
# Removed in 9.0, as it is actually a macro:
|
||||
#declare 422 {
|
||||
# Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
|
||||
# const void *key, int *newPtr)
|
||||
#}
|
||||
declare 421 {
|
||||
Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
|
||||
}
|
||||
declare 422 {
|
||||
Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
|
||||
const void *key, int *newPtr)
|
||||
}
|
||||
declare 423 {
|
||||
void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
|
||||
const Tcl_HashKeyType *typePtr)
|
||||
@@ -1569,16 +1545,14 @@ declare 434 {
|
||||
}
|
||||
|
||||
# TIP#15 (math function introspection) dkf
|
||||
# Removed in 9.0:
|
||||
#declare 435 {deprecated {}} {
|
||||
# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
|
||||
# int *numArgsPtr, Tcl_ValueType **argTypesPtr,
|
||||
# Tcl_MathProc **procPtr, ClientData *clientDataPtr)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 436 {deprecated {}} {
|
||||
# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
|
||||
#}
|
||||
declare 435 {deprecated {}} {
|
||||
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
|
||||
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
|
||||
}
|
||||
declare 436 {deprecated {}} {
|
||||
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
|
||||
}
|
||||
|
||||
# TIP#36 (better access to 'subst') dkf
|
||||
declare 437 {
|
||||
@@ -1640,7 +1614,7 @@ declare 452 {
|
||||
int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 453 {
|
||||
const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
Tcl_Obj **objPtrRef)
|
||||
}
|
||||
declare 454 {
|
||||
@@ -1718,7 +1692,7 @@ declare 476 {
|
||||
Tcl_Obj *pathPtr)
|
||||
}
|
||||
declare 477 {
|
||||
const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
|
||||
CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
|
||||
}
|
||||
declare 478 {
|
||||
Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
|
||||
@@ -2401,6 +2375,9 @@ declare 1 macosx {
|
||||
|
||||
# Public functions that are not accessible via the stubs table.
|
||||
|
||||
export {
|
||||
void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
|
||||
}
|
||||
export {
|
||||
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact)
|
||||
|
||||
+220
-49
@@ -52,15 +52,30 @@ extern "C" {
|
||||
* tools/tcl.hpj.in (not patchlevel, for windows installer)
|
||||
*/
|
||||
|
||||
#define TCL_MAJOR_VERSION 9
|
||||
#define TCL_MINOR_VERSION 0
|
||||
#define TCL_MAJOR_VERSION 8
|
||||
#define TCL_MINOR_VERSION 7
|
||||
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
|
||||
#define TCL_RELEASE_SERIAL 0
|
||||
#define TCL_RELEASE_SERIAL 2
|
||||
|
||||
#define TCL_VERSION "9.0"
|
||||
#define TCL_PATCH_LEVEL "9.0a0"
|
||||
#define TCL_VERSION "8.7"
|
||||
#define TCL_PATCH_LEVEL "8.7a2"
|
||||
|
||||
#if defined(RC_INVOKED)
|
||||
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* The following definitions set up the proper options for Windows compilers.
|
||||
* We use this method because there is no autoconf equivalent.
|
||||
*/
|
||||
|
||||
#ifdef _WIN32
|
||||
# ifndef __WIN32__
|
||||
# define __WIN32__
|
||||
# endif
|
||||
# ifndef WIN32
|
||||
# define WIN32
|
||||
# endif
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Utility macros: STRINGIFY takes an argument and wraps it in "" (double
|
||||
* quotation marks), JOIN joins two arguments.
|
||||
@@ -74,7 +89,11 @@ extern "C" {
|
||||
# define JOIN(a,b) JOIN1(a,b)
|
||||
# define JOIN1(a,b) a##b
|
||||
#endif
|
||||
#endif /* RC_INVOKED */
|
||||
|
||||
#ifndef TCL_THREADS
|
||||
# define TCL_THREADS 1
|
||||
#endif
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
* A special definition used to allow this header file to be included from
|
||||
@@ -88,15 +107,10 @@ extern "C" {
|
||||
#ifndef RC_INVOKED
|
||||
|
||||
/*
|
||||
* Special macro to define mutexes, that doesn't do anything if we are not
|
||||
* using threads.
|
||||
* Special macro to define mutexes.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
|
||||
#else
|
||||
#define TCL_DECLARE_MUTEX(name)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
|
||||
@@ -110,11 +124,32 @@ extern "C" {
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Support for functions with a variable number of arguments.
|
||||
*
|
||||
* The following TCL_VARARGS* macros are to support old extensions
|
||||
* written for older versions of Tcl where the macros permitted
|
||||
* support for the varargs.h system as well as stdarg.h .
|
||||
*
|
||||
* New code should just directly be written to use stdarg.h conventions.
|
||||
*/
|
||||
|
||||
#include <stdarg.h>
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define TCL_VARARGS(type, name) (type name, ...)
|
||||
# define TCL_VARARGS_DEF(type, name) (type name, ...)
|
||||
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
#if defined(__GNUC__) && (__GNUC__ > 2)
|
||||
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
|
||||
# define TCL_NORETURN __attribute__ ((noreturn))
|
||||
# define TCL_NOINLINE __attribute__ ((noinline))
|
||||
# define TCL_NORETURN1 __attribute__ ((noreturn))
|
||||
# if defined(BUILD_tcl) || defined(BUILD_tk)
|
||||
# define TCL_NORETURN1 __attribute__ ((noreturn))
|
||||
# else
|
||||
# define TCL_NORETURN1 /* nothing */
|
||||
# endif
|
||||
#else
|
||||
# define TCL_FORMAT_PRINTF(a,b)
|
||||
# if defined(_MSC_VER) && (_MSC_VER >= 1310)
|
||||
@@ -189,7 +224,7 @@ extern "C" {
|
||||
* to be included in a shared library, then it should have the DLLEXPORT
|
||||
* storage class. If is being declared for use by a module that is going to
|
||||
* link against the shared library, then it should have the DLLIMPORT storage
|
||||
* class. If the symbol is being declared for a static build or for use from a
|
||||
* class. If the symbol is beind declared for a static build or for use from a
|
||||
* stub library, then the storage class should be empty.
|
||||
*
|
||||
* The convention is that a macro called BUILD_xxxx, where xxxx is the name of
|
||||
@@ -210,7 +245,33 @@ extern "C" {
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
|
||||
/*
|
||||
* The following _ANSI_ARGS_ macro is to support old extensions
|
||||
* written for older versions of Tcl where it permitted support
|
||||
* for compilers written in the pre-prototype era of C.
|
||||
*
|
||||
* New code should use prototypes.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# undef _ANSI_ARGS_
|
||||
# define _ANSI_ARGS_(x) x
|
||||
|
||||
/*
|
||||
* Definitions that allow this header file to be used either with or without
|
||||
* ANSI C features.
|
||||
*/
|
||||
|
||||
#ifndef INLINE
|
||||
# define INLINE
|
||||
#endif
|
||||
#ifndef CONST
|
||||
# define CONST const
|
||||
#endif
|
||||
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
#ifndef CONST86
|
||||
# define CONST86 const
|
||||
#endif
|
||||
|
||||
@@ -228,11 +289,41 @@ extern "C" {
|
||||
# define EXTERN extern TCL_STORAGE_CLASS
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* The following code is copied from winnt.h. If we don't replicate it here,
|
||||
* then <windows.h> can't be included after tcl.h, since tcl.h also defines
|
||||
* VOID. This block is skipped under Cygwin and Mingw.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
|
||||
#ifndef VOID
|
||||
#define VOID void
|
||||
typedef char CHAR;
|
||||
typedef short SHORT;
|
||||
typedef long LONG;
|
||||
#endif
|
||||
#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */
|
||||
|
||||
/*
|
||||
* Macro to use instead of "void" for arguments that must have type "void *"
|
||||
* in ANSI C; maps them to type "char *" in non-ANSI systems.
|
||||
*/
|
||||
|
||||
#ifndef __VXWORKS__
|
||||
# define VOID void
|
||||
#endif
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
|
||||
|
||||
/*
|
||||
* Miscellaneous declarations.
|
||||
*/
|
||||
|
||||
typedef void *ClientData;
|
||||
#ifndef _CLIENTDATA
|
||||
typedef void *ClientData;
|
||||
# define _CLIENTDATA
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Darwin specific configure overrides (to support fat compiles, where
|
||||
@@ -369,7 +460,17 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
|
||||
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
|
||||
*/
|
||||
|
||||
typedef struct Tcl_Interp Tcl_Interp;
|
||||
typedef struct Tcl_Interp
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
{
|
||||
/* TIP #330: Strongly discourage extensions from using the string
|
||||
* result. */
|
||||
char *resultDontUse; /* Don't use in extensions! */
|
||||
void (*freeProcDontUse) (char *); /* Don't use in extensions! */
|
||||
int errorLineDontUse; /* Don't use in extensions! */
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
Tcl_Interp;
|
||||
|
||||
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
|
||||
typedef struct Tcl_Channel_ *Tcl_Channel;
|
||||
@@ -518,6 +619,10 @@ typedef struct stat *Tcl_OldStat_;
|
||||
#define TCL_BREAK 3
|
||||
#define TCL_CONTINUE 4
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#define TCL_RESULT_SIZE 200
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Flags to control what substitutions are performed by Tcl_SubstObj():
|
||||
@@ -528,6 +633,27 @@ typedef struct stat *Tcl_OldStat_;
|
||||
#define TCL_SUBST_BACKSLASHES 004
|
||||
#define TCL_SUBST_ALL 007
|
||||
|
||||
/*
|
||||
* Argument descriptors for math function callbacks in expressions:
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
typedef enum {
|
||||
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
|
||||
} Tcl_ValueType;
|
||||
|
||||
typedef struct Tcl_Value {
|
||||
Tcl_ValueType type; /* Indicates intValue or doubleValue is valid,
|
||||
* or both. */
|
||||
long intValue; /* Integer value. */
|
||||
double doubleValue; /* Double-precision floating value. */
|
||||
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
|
||||
} Tcl_Value;
|
||||
#else
|
||||
#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
|
||||
#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Forward declaration of Tcl_Obj to prevent an error when the forward
|
||||
* reference to Tcl_Obj is encountered in the function types declared below.
|
||||
@@ -573,6 +699,8 @@ typedef void (Tcl_FreeProc) (char *blockPtr);
|
||||
typedef void (Tcl_IdleProc) (ClientData clientData);
|
||||
typedef void (Tcl_InterpDeleteProc) (ClientData clientData,
|
||||
Tcl_Interp *interp);
|
||||
typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
Tcl_Value *args, Tcl_Value *resultPtr);
|
||||
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
|
||||
typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
|
||||
int objc, struct Tcl_Obj *const *objv);
|
||||
@@ -684,11 +812,20 @@ int Tcl_IsShared(Tcl_Obj *objPtr);
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* The following type contains the state needed by Tcl_SaveResult. It
|
||||
* is typically allocated on the stack.
|
||||
* The following structure contains the state needed by Tcl_SaveResult. No-one
|
||||
* outside of Tcl should access any of these fields. This structure is
|
||||
* typically allocated on the stack.
|
||||
*/
|
||||
|
||||
typedef Tcl_Obj *Tcl_SavedResult;
|
||||
typedef struct Tcl_SavedResult {
|
||||
char *result;
|
||||
Tcl_FreeProc *freeProc;
|
||||
Tcl_Obj *objResultPtr;
|
||||
char *appendResult;
|
||||
int appendAvl;
|
||||
int appendUsed;
|
||||
char resultSpace[200+1];
|
||||
} Tcl_SavedResult;
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
@@ -813,11 +950,14 @@ typedef struct Tcl_DString {
|
||||
|
||||
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
|
||||
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define Tcl_DStringTrunc Tcl_DStringSetLength
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
* Definitions for the maximum number of digits of precision that may be
|
||||
* produced by Tcl_PrintDouble, and the number of bytes of buffer space
|
||||
* required by Tcl_PrintDouble.
|
||||
* specified in the "tcl_precision" variable, and the number of bytes of
|
||||
* buffer space required by Tcl_PrintDouble.
|
||||
*/
|
||||
|
||||
#define TCL_MAX_PREC 17
|
||||
@@ -931,6 +1071,17 @@ typedef struct Tcl_DString {
|
||||
|
||||
#define TCL_ALLOW_INLINE_COMPILATION 0x20000
|
||||
|
||||
/*
|
||||
* The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
|
||||
* always parsed whenever the part2 is NULL. (This is to avoid a common error
|
||||
* when converting code to use the new object based APIs and forgetting to
|
||||
* give the flag)
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define TCL_PARSE_PART1 0x400
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
* Types for linked variables:
|
||||
*/
|
||||
@@ -984,7 +1135,9 @@ struct Tcl_HashEntry {
|
||||
Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket,
|
||||
* or NULL for end of chain. */
|
||||
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
|
||||
unsigned int hash; /* Hash value. */
|
||||
void *hash; /* Hash value, stored as pointer to ensure
|
||||
* that the offsets of the fields in this
|
||||
* structure are not changed. */
|
||||
ClientData clientData; /* Application stores something here with
|
||||
* Tcl_SetHashValue. */
|
||||
union { /* Key has one of these forms: */
|
||||
@@ -1079,10 +1232,10 @@ struct Tcl_HashTable {
|
||||
* table. */
|
||||
int rebuildSize; /* Enlarge table when numEntries gets to be
|
||||
* this large. */
|
||||
unsigned int mask; /* Mask value used in hashing function. */
|
||||
int downShift; /* Shift count used in hashing function.
|
||||
* Designed to use high-order bits of
|
||||
* randomized keys. */
|
||||
int mask; /* Mask value used in hashing function. */
|
||||
int keyType; /* Type of keys used in this table. It's
|
||||
* either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
|
||||
* TCL_ONE_WORD_KEYS, or an integer giving the
|
||||
@@ -1203,8 +1356,8 @@ typedef struct Tcl_Time {
|
||||
long usec; /* Microseconds. */
|
||||
} Tcl_Time;
|
||||
|
||||
typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
|
||||
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
|
||||
typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr);
|
||||
typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr);
|
||||
|
||||
/*
|
||||
* TIP #233 (Virtualized Time)
|
||||
@@ -1476,7 +1629,7 @@ typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
int nextCheckpoint);
|
||||
typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
|
||||
Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
|
||||
typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
|
||||
typedef const char *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
|
||||
Tcl_Obj **objPtrRef);
|
||||
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
|
||||
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
|
||||
@@ -1778,7 +1931,7 @@ typedef struct Tcl_Token {
|
||||
* TCL_TOKEN_OPERATOR - The token describes one expression operator.
|
||||
* An operator might be the name of a math
|
||||
* function such as "abs". A TCL_TOKEN_OPERATOR
|
||||
* token is always preceeded by one
|
||||
* token is always preceded by one
|
||||
* TCL_TOKEN_SUB_EXPR token for the operator's
|
||||
* subexpression, and is followed by zero or more
|
||||
* TCL_TOKEN_SUB_EXPR tokens for the operator's
|
||||
@@ -1992,9 +2145,9 @@ typedef struct Tcl_EncodingType {
|
||||
|
||||
/*
|
||||
* The maximum number of bytes that are necessary to represent a single
|
||||
* Unicode character in UTF-8. The valid values should be 3, 4 or 6
|
||||
* (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
|
||||
* 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
|
||||
* Unicode character in UTF-8. The valid values are 4 and 6
|
||||
* (or perhaps 1 if we want to support a non-unicode enabled core). If 4,
|
||||
* then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
|
||||
* then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
|
||||
* is the default and recommended mode. UCS-4 is experimental and not
|
||||
* recommended. It works for the core, but most extensions expect UCS-2.
|
||||
@@ -2207,6 +2360,11 @@ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
|
||||
int exact, int magic);
|
||||
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
const char *version, int epoch, int revision);
|
||||
#if defined(_WIN32)
|
||||
TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
|
||||
#else
|
||||
# define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
|
||||
#endif
|
||||
|
||||
#ifdef USE_TCL_STUBS
|
||||
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
|
||||
@@ -2238,7 +2396,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
|
||||
*/
|
||||
|
||||
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
|
||||
((Tcl_CreateInterp)()))
|
||||
((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)()))
|
||||
EXTERN void Tcl_MainEx(int argc, char **argv,
|
||||
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
|
||||
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
|
||||
@@ -2389,31 +2547,44 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
|
||||
* hash tables:
|
||||
*/
|
||||
|
||||
#undef Tcl_FindHashEntry
|
||||
#define Tcl_FindHashEntry(tablePtr, key) \
|
||||
(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
|
||||
#undef Tcl_CreateHashEntry
|
||||
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
|
||||
(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Macros that eliminate the overhead of the thread synchronization functions
|
||||
* when compiling without thread support.
|
||||
* Deprecated Tcl functions:
|
||||
*/
|
||||
|
||||
#ifndef TCL_THREADS
|
||||
#undef Tcl_MutexLock
|
||||
#define Tcl_MutexLock(mutexPtr)
|
||||
#undef Tcl_MutexUnlock
|
||||
#define Tcl_MutexUnlock(mutexPtr)
|
||||
#undef Tcl_MutexFinalize
|
||||
#define Tcl_MutexFinalize(mutexPtr)
|
||||
#undef Tcl_ConditionNotify
|
||||
#define Tcl_ConditionNotify(condPtr)
|
||||
#undef Tcl_ConditionWait
|
||||
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
|
||||
#undef Tcl_ConditionFinalize
|
||||
#define Tcl_ConditionFinalize(condPtr)
|
||||
#endif /* TCL_THREADS */
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
/*
|
||||
* These function have been renamed. The old names are deprecated, but we
|
||||
* define these macros for backwards compatibility.
|
||||
*/
|
||||
|
||||
# define Tcl_Ckalloc Tcl_Alloc
|
||||
# define Tcl_Ckfree Tcl_Free
|
||||
# define Tcl_Ckrealloc Tcl_Realloc
|
||||
# define Tcl_Return Tcl_SetResult
|
||||
# define Tcl_TildeSubst Tcl_TranslateFileName
|
||||
#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */
|
||||
# define panic Tcl_Panic
|
||||
#endif
|
||||
# define panicVA Tcl_PanicVA
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------------
|
||||
* Convenience declaration of Tcl_AppInit for backwards compatibility. This
|
||||
* function is not *implemented* by the tcl library, so the storage class is
|
||||
* neither DLLEXPORT nor DLLIMPORT.
|
||||
*/
|
||||
|
||||
extern Tcl_AppInitProc Tcl_AppInit;
|
||||
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
#endif /* RC_INVOKED */
|
||||
|
||||
|
||||
+3
-3
@@ -22,7 +22,7 @@
|
||||
*/
|
||||
|
||||
#include "tclInt.h"
|
||||
#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
|
||||
#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)
|
||||
|
||||
#if USE_TCLALLOC
|
||||
|
||||
@@ -121,7 +121,7 @@ static struct block bigBlocks={ /* Big blocks aren't suballocated. */
|
||||
* variable.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
static Tcl_Mutex *allocMutexPtr;
|
||||
#endif
|
||||
static int allocInit = 0;
|
||||
@@ -171,7 +171,7 @@ TclInitAlloc(void)
|
||||
{
|
||||
if (!allocInit) {
|
||||
allocInit = 1;
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
allocMutexPtr = Tcl_GetAllocMutex();
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -406,6 +406,7 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
{"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0},
|
||||
{"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0},
|
||||
{"label", ASSEM_LABEL, 0, 0, 0},
|
||||
{"land", ASSEM_1BYTE, INST_LAND, 2, 1},
|
||||
{"lappend", ASSEM_LVT, (INST_LAPPEND_SCALAR1<<8
|
||||
| INST_LAPPEND_SCALAR4),
|
||||
1, 1},
|
||||
@@ -433,6 +434,7 @@ static const TalInstDesc TalInstructionTable[] = {
|
||||
| INST_LOAD_ARRAY4), 1, 1},
|
||||
{"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1},
|
||||
{"loadStk", ASSEM_1BYTE, INST_LOAD_STK, 1, 1},
|
||||
{"lor", ASSEM_1BYTE, INST_LOR, 2, 1},
|
||||
{"lsetFlat", ASSEM_LSET_FLAT,INST_LSET_FLAT, INT_MIN,1},
|
||||
{"lsetList", ASSEM_1BYTE, INST_LSET_LIST, 3, 1},
|
||||
{"lshift", ASSEM_1BYTE, INST_LSHIFT, 2, 1},
|
||||
|
||||
+650
-53
@@ -37,6 +37,18 @@
|
||||
# define MAX_EXACT 9007199254740991.0
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following structure defines the client data for a math function
|
||||
* registered with Tcl_CreateMathFunc
|
||||
*/
|
||||
|
||||
typedef struct OldMathFuncData {
|
||||
Tcl_MathProc *proc; /* Handler function */
|
||||
int numArgs; /* Number of args expected */
|
||||
Tcl_ValueType *argTypes; /* Types of the args */
|
||||
ClientData clientData; /* Client data for the handler function */
|
||||
} OldMathFuncData;
|
||||
|
||||
/*
|
||||
* This is the script cancellation struct and hash table. The hash table is
|
||||
* used to keep track of the information necessary to process script
|
||||
@@ -120,6 +132,10 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
|
||||
static Tcl_NRPostProc NRCoroutineExitCallback;
|
||||
static Tcl_NRPostProc NRCommand;
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
static Tcl_ObjCmdProc OldMathFuncProc;
|
||||
static void OldMathFuncDeleteProc(ClientData clientData);
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
static void ProcessUnexpectedResult(Tcl_Interp *interp,
|
||||
int returnCode);
|
||||
static int RewindCoroutine(CoroutineData *corPtr, int result);
|
||||
@@ -191,6 +207,9 @@ static const CmdInfo builtInCmds[] = {
|
||||
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
|
||||
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
|
||||
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
|
||||
#endif
|
||||
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
|
||||
{"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE},
|
||||
{"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE},
|
||||
@@ -497,12 +516,13 @@ Tcl_CreateInterp(void)
|
||||
iPtr = ckalloc(sizeof(Interp));
|
||||
interp = (Tcl_Interp *) iPtr;
|
||||
|
||||
iPtr->legacyResult = NULL;
|
||||
/* Special invalid value: Any attempt to free the legacy result
|
||||
* will cause a crash. */
|
||||
iPtr->legacyFreeProc = (void (*) (void))-1;
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
iPtr->result = &tclEmptyString;
|
||||
#else
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
#endif
|
||||
iPtr->freeProc = NULL;
|
||||
iPtr->errorLine = 0;
|
||||
iPtr->stubTable = &tclStubs;
|
||||
iPtr->objResultPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(iPtr->objResultPtr);
|
||||
iPtr->handle = TclHandleCreate(iPtr);
|
||||
@@ -510,7 +530,8 @@ Tcl_CreateInterp(void)
|
||||
iPtr->hiddenCmdTablePtr = NULL;
|
||||
iPtr->interpInfo = NULL;
|
||||
|
||||
iPtr->optimizer = TclOptimizeBytecode;
|
||||
TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable));
|
||||
iPtr->extra.optimizer = TclOptimizeBytecode;
|
||||
|
||||
iPtr->numLevels = 0;
|
||||
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
|
||||
@@ -559,6 +580,12 @@ Tcl_CreateInterp(void)
|
||||
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
|
||||
iPtr->lookupNsPtr = NULL;
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
iPtr->appendUsed = 0;
|
||||
#endif
|
||||
|
||||
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
|
||||
iPtr->packageUnknown = NULL;
|
||||
|
||||
@@ -587,6 +614,9 @@ Tcl_CreateInterp(void)
|
||||
iPtr->emptyObjPtr = Tcl_NewObj();
|
||||
/* Another empty object. */
|
||||
Tcl_IncrRefCount(iPtr->emptyObjPtr);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
iPtr->resultSpace[0] = 0;
|
||||
#endif
|
||||
iPtr->threadId = Tcl_GetCurrentThread();
|
||||
|
||||
/* TIP #378 */
|
||||
@@ -696,6 +726,12 @@ Tcl_CreateInterp(void)
|
||||
memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
|
||||
#endif /* TCL_COMPILE_STATS */
|
||||
|
||||
/*
|
||||
* Initialise the stub table pointer.
|
||||
*/
|
||||
|
||||
iPtr->stubTable = &tclStubs;
|
||||
|
||||
/*
|
||||
* Initialize the ensemble error message rewriting support.
|
||||
*/
|
||||
@@ -713,7 +749,7 @@ Tcl_CreateInterp(void)
|
||||
* cache was already initialised by the call to alloc the interp struct.
|
||||
*/
|
||||
|
||||
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
iPtr->allocCache = TclpGetAllocCache();
|
||||
#else
|
||||
iPtr->allocCache = NULL;
|
||||
@@ -921,9 +957,14 @@ Tcl_CreateInterp(void)
|
||||
|
||||
Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
|
||||
Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Tcl_TraceVar2(interp, "tcl_precision", NULL,
|
||||
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
|
||||
TclPrecTraceProc, NULL);
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
TclpSetVariables(interp);
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* The existence of the "threaded" element of the tcl_platform array
|
||||
* indicates that this particular Tcl shell has been compiled with threads
|
||||
@@ -1489,6 +1530,7 @@ DeleteInterpProc(
|
||||
*/
|
||||
|
||||
Tcl_FreeResult(interp);
|
||||
iPtr->result = NULL;
|
||||
Tcl_DecrRefCount(iPtr->objResultPtr);
|
||||
iPtr->objResultPtr = NULL;
|
||||
Tcl_DecrRefCount(iPtr->ecVar);
|
||||
@@ -1510,6 +1552,12 @@ DeleteInterpProc(
|
||||
if (iPtr->returnOpts) {
|
||||
Tcl_DecrRefCount(iPtr->returnOpts);
|
||||
}
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
iPtr->appendResult = NULL;
|
||||
}
|
||||
#endif
|
||||
TclFreePackageInfo(iPtr);
|
||||
while (iPtr->tracePtr != NULL) {
|
||||
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
|
||||
@@ -2247,30 +2295,33 @@ Tcl_CreateObjCommand(
|
||||
}
|
||||
|
||||
Tcl_Command
|
||||
TclCreateObjCommandInNs (
|
||||
TclCreateObjCommandInNs(
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName, /* Name of command, without any namespace components */
|
||||
const char *cmdName, /* Name of command, without any namespace
|
||||
* components. */
|
||||
Tcl_Namespace *namespace, /* The namespace to create the command in */
|
||||
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
|
||||
* name. */
|
||||
ClientData clientData, /* Arbitrary value to pass to object
|
||||
* function. */
|
||||
Tcl_CmdDeleteProc *deleteProc
|
||||
Tcl_CmdDeleteProc *deleteProc)
|
||||
/* If not NULL, gives a function to call when
|
||||
* this command is deleted. */
|
||||
) {
|
||||
{
|
||||
int deleted = 0, isNew = 0;
|
||||
Command *cmdPtr;
|
||||
ImportRef *oldRefPtr = NULL;
|
||||
ImportedCmdData *dataPtr;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Namespace *nsPtr = (Namespace *) namespace;
|
||||
|
||||
/*
|
||||
* If the command name we seek to create already exists, we need to
|
||||
* delete that first. That can be tricky in the presence of traces.
|
||||
* Loop until we no longer find an existing command in the way, or
|
||||
* until we've deleted one command and that didn't finish the job.
|
||||
* If the command name we seek to create already exists, we need to delete
|
||||
* that first. That can be tricky in the presence of traces. Loop until we
|
||||
* no longer find an existing command in the way, or until we've deleted
|
||||
* one command and that didn't finish the job.
|
||||
*/
|
||||
|
||||
while (1) {
|
||||
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
|
||||
|
||||
@@ -2282,16 +2333,18 @@ TclCreateObjCommandInNs (
|
||||
break;
|
||||
}
|
||||
|
||||
/*
|
||||
* An existing command conflicts. Try to delete it.
|
||||
*/
|
||||
|
||||
/* An existing command conflicts. Try to delete it.. */
|
||||
cmdPtr = Tcl_GetHashValue(hPtr);
|
||||
|
||||
/*
|
||||
* [***] This is wrong. See Tcl Bug a16752c252.
|
||||
* However, this buggy behavior is kept under particular
|
||||
* circumstances to accommodate deployed binaries of the
|
||||
* "tclcompiler" program. http://sourceforge.net/projects/tclpro/
|
||||
* that crash if the bug is fixed.
|
||||
* [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
|
||||
* behavior is kept under particular circumstances to accommodate
|
||||
* deployed binaries of the "tclcompiler" program
|
||||
* http://sourceforge.net/projects/tclpro/
|
||||
* that crash if the bug is fixed.
|
||||
*/
|
||||
|
||||
if (cmdPtr->objProc == TclInvokeStringCommand
|
||||
@@ -2315,12 +2368,15 @@ TclCreateObjCommandInNs (
|
||||
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
|
||||
}
|
||||
|
||||
/* Make sure namespace doesn't get deallocated. */
|
||||
/*
|
||||
* Make sure namespace doesn't get deallocated.
|
||||
*/
|
||||
|
||||
cmdPtr->nsPtr->refCount++;
|
||||
|
||||
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
|
||||
nsPtr = (Namespace *) TclEnsureNamespace(interp,
|
||||
(Tcl_Namespace *)cmdPtr->nsPtr);
|
||||
(Tcl_Namespace *) cmdPtr->nsPtr);
|
||||
TclNsDecrRefCount(cmdPtr->nsPtr);
|
||||
|
||||
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
|
||||
@@ -2332,9 +2388,9 @@ TclCreateObjCommandInNs (
|
||||
}
|
||||
if (!isNew) {
|
||||
/*
|
||||
* If the deletion callback recreated the command, just throw away
|
||||
* the new command (if we try to delete it again, we could get
|
||||
* stuck in an infinite loop).
|
||||
* If the deletion callback recreated the command, just throw away the
|
||||
* new command (if we try to delete it again, we could get stuck in an
|
||||
* infinite loop).
|
||||
*/
|
||||
|
||||
ckfree(Tcl_GetHashValue(hPtr));
|
||||
@@ -2389,6 +2445,7 @@ TclCreateObjCommandInNs (
|
||||
cmdPtr->importRefPtr = oldRefPtr;
|
||||
while (oldRefPtr != NULL) {
|
||||
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
|
||||
|
||||
dataPtr = refCmdPtr->objClientData;
|
||||
dataPtr->realCmdPtr = cmdPtr;
|
||||
oldRefPtr = oldRefPtr->nextPtr;
|
||||
@@ -2466,7 +2523,7 @@ TclInvokeStringCommand(
|
||||
* in the Command structure.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl result value.
|
||||
* A standard Tcl string result value.
|
||||
*
|
||||
* Side effects:
|
||||
* Besides those side effects of the called Tcl_ObjCmdProc,
|
||||
@@ -2506,6 +2563,13 @@ TclInvokeObjectCommand(
|
||||
cmdPtr->objClientData, argc, objv);
|
||||
}
|
||||
|
||||
/*
|
||||
* Move the interpreter's object result to the string result, then reset
|
||||
* the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
/*
|
||||
* Decrement the ref counts for the argument objects created above, then
|
||||
* free the objv array if malloc'ed storage was used.
|
||||
@@ -3446,6 +3510,362 @@ TclCleanupCommand(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CreateMathFunc --
|
||||
*
|
||||
* Creates a new math function for expressions in a given interpreter.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The Tcl function defined by "name" is created or redefined. If the
|
||||
* function already exists then its definition is replaced; this includes
|
||||
* the builtin functions. Redefining a builtin function forces all
|
||||
* existing code to be invalidated since that code may be compiled using
|
||||
* an instruction specific to the replaced function. In addition,
|
||||
* redefioning a non-builtin function will force existing code to be
|
||||
* invalidated if the number of arguments has changed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
void
|
||||
Tcl_CreateMathFunc(
|
||||
Tcl_Interp *interp, /* Interpreter in which function is to be
|
||||
* available. */
|
||||
const char *name, /* Name of function (e.g. "sin"). */
|
||||
int numArgs, /* Nnumber of arguments required by
|
||||
* function. */
|
||||
Tcl_ValueType *argTypes, /* Array of types acceptable for each
|
||||
* argument. */
|
||||
Tcl_MathProc *proc, /* C function that implements the math
|
||||
* function. */
|
||||
ClientData clientData) /* Additional value to pass to the
|
||||
* function. */
|
||||
{
|
||||
Tcl_DString bigName;
|
||||
OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
|
||||
|
||||
data->proc = proc;
|
||||
data->numArgs = numArgs;
|
||||
data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
|
||||
memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
|
||||
data->clientData = clientData;
|
||||
|
||||
Tcl_DStringInit(&bigName);
|
||||
TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
|
||||
Tcl_DStringAppend(&bigName, name, -1);
|
||||
|
||||
Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
|
||||
OldMathFuncProc, data, OldMathFuncDeleteProc);
|
||||
Tcl_DStringFree(&bigName);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* OldMathFuncProc --
|
||||
*
|
||||
* Dispatch to a math function created with Tcl_CreateMathFunc
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl result.
|
||||
*
|
||||
* Side effects:
|
||||
* Whatever the math function does.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
OldMathFuncProc(
|
||||
ClientData clientData, /* Pointer to OldMathFuncData describing the
|
||||
* function being called */
|
||||
Tcl_Interp *interp, /* Tcl interpreter */
|
||||
int objc, /* Actual parameter count */
|
||||
Tcl_Obj *const *objv) /* Parameter vector */
|
||||
{
|
||||
Tcl_Obj *valuePtr;
|
||||
OldMathFuncData *dataPtr = clientData;
|
||||
Tcl_Value funcResult, *args;
|
||||
int result;
|
||||
int j, k;
|
||||
double d;
|
||||
|
||||
/*
|
||||
* Check argument count.
|
||||
*/
|
||||
|
||||
if (objc != dataPtr->numArgs + 1) {
|
||||
MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert arguments from Tcl_Obj's to Tcl_Value's.
|
||||
*/
|
||||
|
||||
args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
|
||||
for (j = 1, k = 0; j < objc; ++j, ++k) {
|
||||
/* TODO: Convert to TclGetNumberFromObj? */
|
||||
valuePtr = objv[j];
|
||||
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
|
||||
#ifdef ACCEPT_NAN
|
||||
if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
|
||||
d = valuePtr->internalRep.doubleValue;
|
||||
result = TCL_OK;
|
||||
}
|
||||
#endif
|
||||
if (result != TCL_OK) {
|
||||
/*
|
||||
* We have a non-numeric argument.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"argument to math function didn't have numeric value",
|
||||
-1));
|
||||
TclCheckBadOctal(interp, TclGetString(valuePtr));
|
||||
ckfree(args);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the object's numeric value to the argument record, converting
|
||||
* it if necessary.
|
||||
*
|
||||
* NOTE: no bignum support; use the new mathfunc interface for that.
|
||||
*/
|
||||
|
||||
args[k].type = dataPtr->argTypes[k];
|
||||
switch (args[k].type) {
|
||||
case TCL_EITHER:
|
||||
if (Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue)
|
||||
== TCL_OK) {
|
||||
args[k].type = TCL_INT;
|
||||
break;
|
||||
}
|
||||
if (TclGetWideIntFromObj(interp, valuePtr, &args[k].wideValue)
|
||||
== TCL_OK) {
|
||||
args[k].type = TCL_WIDE_INT;
|
||||
break;
|
||||
}
|
||||
args[k].type = TCL_DOUBLE;
|
||||
/* FALLTHROUGH */
|
||||
|
||||
case TCL_DOUBLE:
|
||||
args[k].doubleValue = d;
|
||||
break;
|
||||
case TCL_INT:
|
||||
if (ExprIntFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
|
||||
ckfree(args);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
valuePtr = Tcl_GetObjResult(interp);
|
||||
Tcl_GetLongFromObj(NULL, valuePtr, &args[k].intValue);
|
||||
Tcl_ResetResult(interp);
|
||||
break;
|
||||
case TCL_WIDE_INT:
|
||||
if (ExprWideFunc(NULL, interp, 2, &objv[j-1]) != TCL_OK) {
|
||||
ckfree(args);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
valuePtr = Tcl_GetObjResult(interp);
|
||||
TclGetWideIntFromObj(NULL, valuePtr, &args[k].wideValue);
|
||||
Tcl_ResetResult(interp);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Call the function.
|
||||
*/
|
||||
|
||||
errno = 0;
|
||||
result = dataPtr->proc(dataPtr->clientData, interp, args, &funcResult);
|
||||
ckfree(args);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* Return the result of the call.
|
||||
*/
|
||||
|
||||
if (funcResult.type == TCL_INT) {
|
||||
TclNewIntObj(valuePtr, funcResult.intValue);
|
||||
} else if (funcResult.type == TCL_WIDE_INT) {
|
||||
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
|
||||
} else {
|
||||
return CheckDoubleResult(interp, funcResult.doubleValue);
|
||||
}
|
||||
Tcl_SetObjResult(interp, valuePtr);
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* OldMathFuncDeleteProc --
|
||||
*
|
||||
* Cleans up after deleting a math function registered with
|
||||
* Tcl_CreateMathFunc
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Frees allocated memory.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static void
|
||||
OldMathFuncDeleteProc(
|
||||
ClientData clientData)
|
||||
{
|
||||
OldMathFuncData *dataPtr = clientData;
|
||||
|
||||
ckfree(dataPtr->argTypes);
|
||||
ckfree(dataPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_GetMathFuncInfo --
|
||||
*
|
||||
* Discovers how a particular math function was created in a given
|
||||
* interpreter.
|
||||
*
|
||||
* Results:
|
||||
* TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
|
||||
* interpreter result if that happens.)
|
||||
*
|
||||
* Side effects:
|
||||
* If this function succeeds, the variables pointed to by the numArgsPtr
|
||||
* and argTypePtr arguments will be updated to detail the arguments
|
||||
* allowed by the function. The variable pointed to by the procPtr
|
||||
* argument will be set to NULL if the function is a builtin function,
|
||||
* and will be set to the address of the C function used to implement the
|
||||
* math function otherwise (in which case the variable pointed to by the
|
||||
* clientDataPtr argument will also be updated.)
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
Tcl_GetMathFuncInfo(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
int *numArgsPtr,
|
||||
Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr,
|
||||
ClientData *clientDataPtr)
|
||||
{
|
||||
Tcl_Obj *cmdNameObj;
|
||||
Command *cmdPtr;
|
||||
|
||||
/*
|
||||
* Get the command that implements the math function.
|
||||
*/
|
||||
|
||||
TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
|
||||
Tcl_AppendToObj(cmdNameObj, name, -1);
|
||||
Tcl_IncrRefCount(cmdNameObj);
|
||||
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
|
||||
Tcl_DecrRefCount(cmdNameObj);
|
||||
|
||||
/*
|
||||
* Report unknown functions.
|
||||
*/
|
||||
|
||||
if (cmdPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"unknown math function \"%s\"", name));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
|
||||
*numArgsPtr = -1;
|
||||
*argTypesPtr = NULL;
|
||||
*procPtr = NULL;
|
||||
*clientDataPtr = NULL;
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Retrieve function info for user defined functions; return dummy
|
||||
* information for builtins.
|
||||
*/
|
||||
|
||||
if (cmdPtr->objProc == &OldMathFuncProc) {
|
||||
OldMathFuncData *dataPtr = cmdPtr->clientData;
|
||||
|
||||
*procPtr = dataPtr->proc;
|
||||
*numArgsPtr = dataPtr->numArgs;
|
||||
*argTypesPtr = dataPtr->argTypes;
|
||||
*clientDataPtr = dataPtr->clientData;
|
||||
} else {
|
||||
*procPtr = NULL;
|
||||
*numArgsPtr = -1;
|
||||
*argTypesPtr = NULL;
|
||||
*procPtr = NULL;
|
||||
*clientDataPtr = NULL;
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_ListMathFuncs --
|
||||
*
|
||||
* Produces a list of all the math functions defined in a given
|
||||
* interpreter.
|
||||
*
|
||||
* Results:
|
||||
* A pointer to a Tcl_Obj structure with a reference count of zero, or
|
||||
* NULL in the case of an error (in which case a suitable error message
|
||||
* will be left in the interpreter result.)
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_ListMathFuncs(
|
||||
Tcl_Interp *interp,
|
||||
const char *pattern)
|
||||
{
|
||||
Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
|
||||
Tcl_Obj *result;
|
||||
Tcl_InterpState state;
|
||||
|
||||
if (pattern) {
|
||||
Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
|
||||
Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);
|
||||
|
||||
Tcl_AppendObjToObj(script, arg);
|
||||
Tcl_DecrRefCount(arg); /* Should tear down patternObj too */
|
||||
}
|
||||
|
||||
state = Tcl_SaveInterpState(interp, TCL_OK);
|
||||
Tcl_IncrRefCount(script);
|
||||
if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
|
||||
result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
|
||||
} else {
|
||||
result = Tcl_NewObj();
|
||||
}
|
||||
Tcl_DecrRefCount(script);
|
||||
Tcl_RestoreInterpState(interp, state);
|
||||
|
||||
return result;
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3459,7 +3879,7 @@ TclCleanupCommand(
|
||||
* otherwise.
|
||||
*
|
||||
* Side effects:
|
||||
* The interpreter's result is cleared.
|
||||
* The interpreters object and string results are cleared.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -3471,8 +3891,8 @@ TclInterpReady(
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
|
||||
/*
|
||||
* Reset the interpreter's result and clear out any previous error
|
||||
* information.
|
||||
* Reset both the interpreter's string and object results and clear out
|
||||
* any previous error information.
|
||||
*/
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
@@ -4052,9 +4472,30 @@ TclNRRunCallbacks(
|
||||
/* All callbacks down to rootPtr not inclusive
|
||||
* are to be run. */
|
||||
{
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
NRE_callback *callbackPtr;
|
||||
Tcl_NRPostProc *procPtr;
|
||||
|
||||
/*
|
||||
* If the interpreter has a non-empty string result, the result object is
|
||||
* either empty or stale because some function set interp->result
|
||||
* directly. If so, move the string result to the result object, then
|
||||
* reset the string result.
|
||||
*
|
||||
* This only needs to be done for the first item in the list: all other
|
||||
* are for NR function calls, and those are Tcl_Obj based.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
if (*(iPtr->result) != 0) {
|
||||
(void) Tcl_GetObjResult(interp);
|
||||
}
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
/* This is the trampoline. */
|
||||
|
||||
while (TOP_CB(interp) != rootPtr) {
|
||||
callbackPtr = TOP_CB(interp);
|
||||
procPtr = callbackPtr->procPtr;
|
||||
@@ -4369,7 +4810,7 @@ TEOV_RunEnterTraces(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Command *cmdPtr = *cmdPtrPtr;
|
||||
size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
|
||||
unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
|
||||
int length, traceCode = TCL_OK;
|
||||
const char *command = TclGetStringFromObj(commandPtr, &length);
|
||||
|
||||
@@ -4512,6 +4953,56 @@ Tcl_EvalTokensStandard(
|
||||
NULL, NULL);
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_EvalTokens --
|
||||
*
|
||||
* Given an array of tokens parsed from a Tcl command (e.g., the tokens
|
||||
* that make up a word or the index for an array variable) this function
|
||||
* evaluates the tokens and concatenates their values to form a single
|
||||
* result value.
|
||||
*
|
||||
* Results:
|
||||
* The return value is a pointer to a newly allocated Tcl_Obj containing
|
||||
* the value of the array of tokens. The reference count of the returned
|
||||
* object has been incremented. If an error occurs in evaluating the
|
||||
* tokens then a NULL value is returned and an error message is left in
|
||||
* interp's result.
|
||||
*
|
||||
* Side effects:
|
||||
* A new object is allocated to hold the result.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* This uses a non-standard return convention; its use is now deprecated. It
|
||||
* is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
|
||||
* in the core any longer. It is only kept for backward compatibility.
|
||||
*/
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_EvalTokens(
|
||||
Tcl_Interp *interp, /* Interpreter in which to lookup variables,
|
||||
* execute nested commands, and report
|
||||
* errors. */
|
||||
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
|
||||
* evaluate and concatenate. */
|
||||
int count) /* Number of tokens to consider at tokenPtr.
|
||||
* Must be at least 1. */
|
||||
{
|
||||
Tcl_Obj *resPtr;
|
||||
|
||||
if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
|
||||
return NULL;
|
||||
}
|
||||
resPtr = Tcl_GetObjResult(interp);
|
||||
Tcl_IncrRefCount(resPtr);
|
||||
Tcl_ResetResult(interp);
|
||||
return resPtr;
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -5474,7 +5965,50 @@ Tcl_Eval(
|
||||
* previous call to Tcl_CreateInterp). */
|
||||
const char *script) /* Pointer to TCL command to execute. */
|
||||
{
|
||||
return Tcl_EvalEx(interp, script, -1, 0);
|
||||
int code = Tcl_EvalEx(interp, script, -1, 0);
|
||||
|
||||
/*
|
||||
* For backwards compatibility with old C code that predates the object
|
||||
* system in Tcl 8.0, we have to mirror the object result back into the
|
||||
* string result (some callers may expect it there).
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
return code;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_EvalObj, Tcl_GlobalEvalObj --
|
||||
*
|
||||
* These functions are deprecated but we keep them around for backwards
|
||||
* compatibility reasons.
|
||||
*
|
||||
* Results:
|
||||
* See the functions they call.
|
||||
*
|
||||
* Side effects:
|
||||
* See the functions they call.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_EvalObj
|
||||
int
|
||||
Tcl_EvalObj(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
return Tcl_EvalObjEx(interp, objPtr, 0);
|
||||
}
|
||||
#undef Tcl_GlobalEvalObj
|
||||
int
|
||||
Tcl_GlobalEvalObj(
|
||||
Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
@@ -5863,6 +6397,9 @@ Tcl_ExprLong(
|
||||
Tcl_IncrRefCount(exprPtr);
|
||||
result = Tcl_ExprLongObj(interp, exprPtr, ptr);
|
||||
Tcl_DecrRefCount(exprPtr);
|
||||
if (result != TCL_OK) {
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
}
|
||||
}
|
||||
return result;
|
||||
}
|
||||
@@ -5889,6 +6426,9 @@ Tcl_ExprDouble(
|
||||
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
|
||||
Tcl_DecrRefCount(exprPtr);
|
||||
/* Discard the expression object. */
|
||||
if (result != TCL_OK) {
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
}
|
||||
}
|
||||
return result;
|
||||
}
|
||||
@@ -5914,6 +6454,14 @@ Tcl_ExprBoolean(
|
||||
Tcl_IncrRefCount(exprPtr);
|
||||
result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
|
||||
Tcl_DecrRefCount(exprPtr);
|
||||
if (result != TCL_OK) {
|
||||
/*
|
||||
* Move the interpreter's object result to the string result, then
|
||||
* reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
}
|
||||
@@ -6227,6 +6775,12 @@ Tcl_ExprString(
|
||||
Tcl_DecrRefCount(resultPtr);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Force the string rep of the interp result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
return code;
|
||||
}
|
||||
|
||||
@@ -6333,7 +6887,20 @@ Tcl_AddObjErrorInfo(
|
||||
|
||||
iPtr->flags |= ERR_LEGACY_COPY;
|
||||
if (iPtr->errorInfo == NULL) {
|
||||
iPtr->errorInfo = iPtr->objResultPtr;
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
if (*(iPtr->result) != 0) {
|
||||
/*
|
||||
* The interp's string result is set, apparently by some extension
|
||||
* making a deprecated direct write to it. That extension may
|
||||
* expect interp->result to continue to be set, so we'll take
|
||||
* special pains to avoid clearing it, until we drop support for
|
||||
* interp->result completely.
|
||||
*/
|
||||
|
||||
iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
|
||||
} else
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
iPtr->errorInfo = iPtr->objResultPtr;
|
||||
Tcl_IncrRefCount(iPtr->errorInfo);
|
||||
if (!iPtr->errorCode) {
|
||||
Tcl_SetErrorCode(interp, "NONE", NULL);
|
||||
@@ -6355,34 +6922,32 @@ Tcl_AddObjErrorInfo(
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_VarEval --
|
||||
* Tcl_VarEvalVA --
|
||||
*
|
||||
* Given a variable number of string arguments, concatenate them all
|
||||
* together and execute the result as a Tcl command.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl return result. An error message or other result may be
|
||||
* left in the interp.
|
||||
* left in the interp's result.
|
||||
*
|
||||
* Side effects:
|
||||
* Depends on what was done by the command.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
|
||||
int
|
||||
Tcl_VarEval(
|
||||
Tcl_Interp *interp,
|
||||
...)
|
||||
Tcl_VarEvalVA(
|
||||
Tcl_Interp *interp, /* Interpreter in which to evaluate command */
|
||||
va_list argList) /* Variable argument list. */
|
||||
{
|
||||
va_list argList;
|
||||
int result;
|
||||
Tcl_DString buf;
|
||||
char *string;
|
||||
int result;
|
||||
|
||||
va_start(argList, interp);
|
||||
/*
|
||||
* Copy the strings one after the other into a single larger string. Use
|
||||
* stack-allocated space for small commands, but if the command gets too
|
||||
@@ -6403,6 +6968,39 @@ Tcl_VarEval(
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_VarEval --
|
||||
*
|
||||
* Given a variable number of string arguments, concatenate them all
|
||||
* together and execute the result as a Tcl command.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl return result. An error message or other result may be
|
||||
* left in interp->result.
|
||||
*
|
||||
* Side effects:
|
||||
* Depends on what was done by the command.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Tcl_VarEval(
|
||||
Tcl_Interp *interp,
|
||||
...)
|
||||
{
|
||||
va_list argList;
|
||||
int result;
|
||||
|
||||
va_start(argList, interp);
|
||||
result = Tcl_VarEvalVA(interp, argList);
|
||||
va_end(argList);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -7687,23 +8285,26 @@ Tcl_NRCreateCommand(
|
||||
* this command is deleted. */
|
||||
{
|
||||
Command *cmdPtr = (Command *)
|
||||
Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
|
||||
Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
|
||||
deleteProc);
|
||||
|
||||
cmdPtr->nreProc = nreProc;
|
||||
return (Tcl_Command) cmdPtr;
|
||||
}
|
||||
|
||||
Tcl_Command
|
||||
TclNRCreateCommandInNs (
|
||||
TclNRCreateCommandInNs(
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
Tcl_ObjCmdProc *nreProc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc) {
|
||||
Tcl_CmdDeleteProc *deleteProc)
|
||||
{
|
||||
Command *cmdPtr = (Command *)
|
||||
TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
|
||||
TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
|
||||
deleteProc);
|
||||
|
||||
cmdPtr->nreProc = nreProc;
|
||||
return (Tcl_Command) cmdPtr;
|
||||
@@ -7807,7 +8408,6 @@ TclPushTailcallPoint(
|
||||
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
|
||||
((Interp *) interp)->numLevels++;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -7843,7 +8443,6 @@ TclSetTailcall(
|
||||
}
|
||||
runPtr->data[1] = listPtr;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -7919,7 +8518,6 @@ TclNRTailcallObjCmd(
|
||||
}
|
||||
return TCL_RETURN;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -7987,7 +8585,6 @@ TclNRReleaseValues(
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
Tcl_NRAddCallback(
|
||||
|
||||
+1
-1
@@ -267,7 +267,7 @@ const Tcl_ObjType tclByteArrayType = {
|
||||
* fewer mallocs.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ByteArray {
|
||||
int used; /* The number of bytes used in the byte
|
||||
* array. */
|
||||
int allocated; /* The amount of space actually allocated
|
||||
|
||||
@@ -33,7 +33,7 @@
|
||||
* "memory tag" command is invoked, to hold the current tag.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct MemTag {
|
||||
size_t refCount; /* Number of mem_headers referencing this
|
||||
* tag. */
|
||||
char string[1]; /* Actual size of string will be as large as
|
||||
@@ -156,7 +156,7 @@ TclInitDbCkalloc(void)
|
||||
if (!ckallocInit) {
|
||||
ckallocInit = 1;
|
||||
ckallocMutexPtr = Tcl_GetAllocMutex();
|
||||
#ifndef TCL_THREADS
|
||||
#if !TCL_THREADS
|
||||
/* Silence compiler warning */
|
||||
(void)ckallocMutexPtr;
|
||||
#endif
|
||||
|
||||
+1
-1
@@ -100,7 +100,7 @@ typedef struct {
|
||||
* Structure containing the fields used in [clock format] and [clock scan]
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct TclDateFields {
|
||||
Tcl_WideInt seconds; /* Time expressed in seconds from the Posix
|
||||
* epoch */
|
||||
Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds
|
||||
|
||||
@@ -147,6 +147,143 @@ Tcl_BreakObjCmd(
|
||||
return TCL_BREAK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CaseObjCmd --
|
||||
*
|
||||
* This procedure is invoked to process the "case" Tcl command. See the
|
||||
* user documentation for details on what it does. THIS COMMAND IS
|
||||
* OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
|
||||
*
|
||||
* Results:
|
||||
* A standard Tcl object result.
|
||||
*
|
||||
* Side effects:
|
||||
* See the user documentation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
/* ARGSUSED */
|
||||
int
|
||||
Tcl_CaseObjCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* Argument objects. */
|
||||
{
|
||||
register int i;
|
||||
int body, result, caseObjc;
|
||||
const char *stringPtr, *arg;
|
||||
Tcl_Obj *const *caseObjv;
|
||||
Tcl_Obj *armPtr;
|
||||
|
||||
if (objc < 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
"string ?in? ?pattern body ...? ?default body?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
stringPtr = TclGetString(objv[1]);
|
||||
body = -1;
|
||||
|
||||
arg = TclGetString(objv[2]);
|
||||
if (strcmp(arg, "in") == 0) {
|
||||
i = 3;
|
||||
} else {
|
||||
i = 2;
|
||||
}
|
||||
caseObjc = objc - i;
|
||||
caseObjv = objv + i;
|
||||
|
||||
/*
|
||||
* If all of the pattern/command pairs are lumped into a single argument,
|
||||
* split them out again.
|
||||
*/
|
||||
|
||||
if (caseObjc == 1) {
|
||||
Tcl_Obj **newObjv;
|
||||
|
||||
TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
|
||||
caseObjv = newObjv;
|
||||
}
|
||||
|
||||
for (i = 0; i < caseObjc; i += 2) {
|
||||
int patObjc, j;
|
||||
const char **patObjv;
|
||||
const char *pat, *p;
|
||||
|
||||
if (i == caseObjc-1) {
|
||||
Tcl_ResetResult(interp);
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"extra case pattern with no body", -1));
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Check for special case of single pattern (no list) with no
|
||||
* backslash sequences.
|
||||
*/
|
||||
|
||||
pat = TclGetString(caseObjv[i]);
|
||||
for (p = pat; *p != '\0'; p++) {
|
||||
if (TclIsSpaceProc(*p) || (*p == '\\')) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (*p == '\0') {
|
||||
if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
|
||||
body = i + 1;
|
||||
}
|
||||
if (Tcl_StringMatch(stringPtr, pat)) {
|
||||
body = i + 1;
|
||||
goto match;
|
||||
}
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* Break up pattern lists, then check each of the patterns in the
|
||||
* list.
|
||||
*/
|
||||
|
||||
result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
|
||||
if (result != TCL_OK) {
|
||||
return result;
|
||||
}
|
||||
for (j = 0; j < patObjc; j++) {
|
||||
if (Tcl_StringMatch(stringPtr, patObjv[j])) {
|
||||
body = i + 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
ckfree(patObjv);
|
||||
if (j < patObjc) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
match:
|
||||
if (body != -1) {
|
||||
armPtr = caseObjv[body - 1];
|
||||
result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
|
||||
if (result == TCL_ERROR) {
|
||||
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
|
||||
"\n (\"%.50s\" arm line %d)",
|
||||
TclGetString(armPtr), Tcl_GetErrorLine(interp)));
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* Nothing matched: return nothing.
|
||||
*/
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+1
-1
@@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);
|
||||
* The following structure is used to pass this information.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct SortInfo {
|
||||
int isIncreasing; /* Nonzero means sort in increasing order. */
|
||||
int sortMode; /* The sort mode. One of SORTMODE_* values
|
||||
* defined below. */
|
||||
|
||||
+51
-182
@@ -597,9 +597,9 @@ Tcl_RegsubObjCmd(
|
||||
* slightly modified version of the one pair STR_MAP code.
|
||||
*/
|
||||
|
||||
int slen, nocase;
|
||||
int slen, nocase, wsrclc;
|
||||
int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
|
||||
Tcl_UniChar *p, wsrclc;
|
||||
Tcl_UniChar *p;
|
||||
|
||||
numMatches = 0;
|
||||
nocase = (cflags & TCL_REG_NOCASE);
|
||||
@@ -1576,9 +1576,11 @@ StringIsCmd(
|
||||
string1 = TclGetStringFromObj(objPtr, &length1);
|
||||
result = length1 == 0;
|
||||
}
|
||||
} else if ((objPtr->internalRep.wideValue != 0)
|
||||
? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
|
||||
result = 0;
|
||||
} else if (index != STR_IS_BOOL) {
|
||||
TclGetBooleanFromObj(NULL, objPtr, &i);
|
||||
if ((index == STR_IS_TRUE) ^ i) {
|
||||
result = 0;
|
||||
}
|
||||
}
|
||||
break;
|
||||
case STR_IS_CONTROL:
|
||||
@@ -1999,8 +2001,8 @@ StringMapCmd(
|
||||
* larger strings.
|
||||
*/
|
||||
|
||||
int mapLen;
|
||||
Tcl_UniChar *mapString, u2lc;
|
||||
int mapLen, u2lc;
|
||||
Tcl_UniChar *mapString;
|
||||
|
||||
ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
|
||||
p = ustring1;
|
||||
@@ -2031,8 +2033,8 @@ StringMapCmd(
|
||||
}
|
||||
}
|
||||
} else {
|
||||
Tcl_UniChar **mapStrings, *u2lc = NULL;
|
||||
int *mapLens;
|
||||
Tcl_UniChar **mapStrings;
|
||||
int *mapLens, *u2lc = NULL;
|
||||
|
||||
/*
|
||||
* Precompute pointers to the unicode string and length. This saves us
|
||||
@@ -2044,7 +2046,7 @@ StringMapCmd(
|
||||
mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
|
||||
mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
|
||||
if (nocase) {
|
||||
u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
|
||||
u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
|
||||
}
|
||||
for (index = 0; index < mapElemc; index++) {
|
||||
mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
|
||||
@@ -2544,10 +2546,8 @@ StringEqualCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
const char *string1, *string2;
|
||||
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
|
||||
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
|
||||
strCmpFn_t strCmpFn;
|
||||
const char *string2;
|
||||
int length, i, match, nocase = 0, reqlength = -1;
|
||||
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
@@ -2557,11 +2557,11 @@ StringEqualCmd(
|
||||
}
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length2);
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length);
|
||||
if ((length > 1) && !strncmp(string2, "-nocase", (size_t)length)) {
|
||||
nocase = 1;
|
||||
} else if ((length2 > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length2)) {
|
||||
} else if ((length > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
@@ -2586,78 +2586,7 @@ StringEqualCmd(
|
||||
|
||||
objv += objc-2;
|
||||
|
||||
if ((reqlength == 0) || (objv[0] == objv[1])) {
|
||||
/*
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (!nocase && TclIsPureByteArray(objv[0]) &&
|
||||
TclIsPureByteArray(objv[1])) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
* case-sensitive (which is all that really makes sense with byte
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t) memcmp;
|
||||
} else if ((objv[0]->typePtr == &tclStringType)
|
||||
&& (objv[1]->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of String
|
||||
* type. In benchmark testing this proved the most efficient check
|
||||
* between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t)
|
||||
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
|
||||
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
|
||||
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
|
||||
* case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
|
||||
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
length1 = Tcl_NumUtfChars(string1, length1);
|
||||
length2 = Tcl_NumUtfChars(string2, length2);
|
||||
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
|
||||
if ((reqlength < 0) && (length1 != length2)) {
|
||||
match = 1; /* This will be reversed below. */
|
||||
} else {
|
||||
length = (length1 < length2) ? length1 : length2;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
/*
|
||||
* The requested length is negative, so we ignore it by setting it
|
||||
* to length + 1 so we correct the match var.
|
||||
*/
|
||||
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
match = strCmpFn(string1, string2, (unsigned) length);
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = length1 - length2;
|
||||
}
|
||||
}
|
||||
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
|
||||
return TCL_OK;
|
||||
@@ -2694,11 +2623,31 @@ StringCmpCmd(
|
||||
* the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
|
||||
*/
|
||||
|
||||
const char *string1, *string2;
|
||||
int length1, length2, i, match, length, nocase = 0, reqlength = -1;
|
||||
typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
|
||||
strCmpFn_t strCmpFn;
|
||||
int match, nocase, reqlength, status;
|
||||
|
||||
status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
|
||||
if (status != TCL_OK) {
|
||||
return status;
|
||||
}
|
||||
|
||||
objv += objc-2;
|
||||
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
int TclStringCmpOpts(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[], /* Argument objects. */
|
||||
int *nocase,
|
||||
int *reqlength)
|
||||
{
|
||||
int i, length;
|
||||
const char *string;
|
||||
|
||||
*reqlength = -1;
|
||||
*nocase = 0;
|
||||
if (objc < 3 || objc > 6) {
|
||||
str_cmp_args:
|
||||
Tcl_WrongNumArgs(interp, 1, objv,
|
||||
@@ -2707,106 +2656,27 @@ StringCmpCmd(
|
||||
}
|
||||
|
||||
for (i = 1; i < objc-2; i++) {
|
||||
string2 = TclGetStringFromObj(objv[i], &length2);
|
||||
if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
|
||||
nocase = 1;
|
||||
} else if ((length2 > 1)
|
||||
&& !strncmp(string2, "-length", (size_t)length2)) {
|
||||
string = TclGetStringFromObj(objv[i], &length);
|
||||
if ((length > 1) && !strncmp(string, "-nocase", (size_t)length)) {
|
||||
*nocase = 1;
|
||||
} else if ((length > 1)
|
||||
&& !strncmp(string, "-length", (size_t)length)) {
|
||||
if (i+1 >= objc-2) {
|
||||
goto str_cmp_args;
|
||||
}
|
||||
i++;
|
||||
if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
|
||||
if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
} else {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"bad option \"%s\": must be -nocase or -length",
|
||||
string2));
|
||||
string));
|
||||
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
|
||||
string2, NULL);
|
||||
string, NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* From now on, we only access the two objects at the end of the argument
|
||||
* array.
|
||||
*/
|
||||
|
||||
objv += objc-2;
|
||||
|
||||
if ((reqlength == 0) || (objv[0] == objv[1])) {
|
||||
/*
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
if (!nocase && TclIsPureByteArray(objv[0]) &&
|
||||
TclIsPureByteArray(objv[1])) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
* case-sensitive (which is all that really makes sense with byte
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t) memcmp;
|
||||
} else if ((objv[0]->typePtr == &tclStringType)
|
||||
&& (objv[1]->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of String
|
||||
* type. In benchmark testing this proved the most efficient check
|
||||
* between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
|
||||
string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
|
||||
strCmpFn = (strCmpFn_t)
|
||||
(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use memcmp() as
|
||||
* that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
|
||||
* utf rep). We can use the more efficient TclpUtfNcmp2 if we are
|
||||
* case-sensitive and no specific length was requested.
|
||||
*/
|
||||
|
||||
string1 = (char *) TclGetStringFromObj(objv[0], &length1);
|
||||
string2 = (char *) TclGetStringFromObj(objv[1], &length2);
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
length1 = Tcl_NumUtfChars(string1, length1);
|
||||
length2 = Tcl_NumUtfChars(string2, length2);
|
||||
strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
|
||||
length = (length1 < length2) ? length1 : length2;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
/*
|
||||
* The requested length is negative, so we ignore it by setting it to
|
||||
* length + 1 so we correct the match var.
|
||||
*/
|
||||
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
match = strCmpFn(string1, string2, (unsigned) length);
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = length1 - length2;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp,
|
||||
Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
@@ -2872,7 +2742,6 @@ StringCatCmd(
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
StringBytesCmd(
|
||||
ClientData dummy, /* Not used. */
|
||||
|
||||
+23
-21
@@ -27,7 +27,6 @@ static void CompileReturnInternal(CompileEnv *envPtr,
|
||||
Tcl_Obj *returnOpts);
|
||||
static int IndexTailVarIfKnown(Tcl_Interp *interp,
|
||||
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -127,9 +126,12 @@ TclCompileGlobalCmd(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/* TODO: Consider what value can pass through the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord()
|
||||
* likely does not apply here. Push known value instead. */
|
||||
/*
|
||||
* TODO: Consider what value can pass through the
|
||||
* IndexTailVarIfKnown() screen. Full CompileWord() likely does not
|
||||
* apply here. Push known value instead.
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
|
||||
}
|
||||
@@ -270,7 +272,7 @@ TclCompileIfCmd(
|
||||
jumpIndex = jumpFalseFixupArray.next;
|
||||
jumpFalseFixupArray.next++;
|
||||
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
|
||||
jumpFalseFixupArray.fixup+jumpIndex);
|
||||
jumpFalseFixupArray.fixup + jumpIndex);
|
||||
}
|
||||
code = TCL_OK;
|
||||
}
|
||||
@@ -317,7 +319,7 @@ TclCompileIfCmd(
|
||||
}
|
||||
jumpEndFixupArray.next++;
|
||||
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
|
||||
jumpEndFixupArray.fixup+jumpIndex);
|
||||
jumpEndFixupArray.fixup + jumpIndex);
|
||||
|
||||
/*
|
||||
* Fix the target of the jumpFalse after the test. Generate a 4
|
||||
@@ -329,7 +331,7 @@ TclCompileIfCmd(
|
||||
|
||||
TclAdjustStackDepth(-1, envPtr);
|
||||
if (TclFixupForwardJumpToHere(envPtr,
|
||||
jumpFalseFixupArray.fixup+jumpIndex, 120)) {
|
||||
jumpFalseFixupArray.fixup + jumpIndex, 120)) {
|
||||
/*
|
||||
* Adjust the code offset for the proceeding jump to the end
|
||||
* of the "if" command.
|
||||
@@ -412,7 +414,7 @@ TclCompileIfCmd(
|
||||
for (j = jumpEndFixupArray.next; j > 0; j--) {
|
||||
jumpIndex = (j - 1); /* i.e. process the closest jump first. */
|
||||
if (TclFixupForwardJumpToHere(envPtr,
|
||||
jumpEndFixupArray.fixup+jumpIndex, 127)) {
|
||||
jumpEndFixupArray.fixup + jumpIndex, 127)) {
|
||||
/*
|
||||
* Adjust the immediately preceeding "ifFalse" jump. We moved it's
|
||||
* target (just after this jump) down three bytes.
|
||||
@@ -920,7 +922,7 @@ TclCompileLappendCmd(
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i);
|
||||
valueTokenPtr = TokenAfter(valueTokenPtr);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
|
||||
TclEmitInstInt4( INST_LIST, numWords - 2, envPtr);
|
||||
if (isScalar) {
|
||||
if (localIndex < 0) {
|
||||
TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
|
||||
@@ -997,7 +999,7 @@ TclCompileLassignCmd(
|
||||
*/
|
||||
|
||||
PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
|
||||
&isScalar, idx+2);
|
||||
&isScalar, idx + 2);
|
||||
|
||||
/*
|
||||
* Emit instructions to get the idx'th item out of the list value on
|
||||
@@ -1414,7 +1416,7 @@ TclCompileLinsertCmd(
|
||||
tokenPtr = TokenAfter(tokenPtr);
|
||||
CompileWord(envPtr, tokenPtr, interp, i);
|
||||
}
|
||||
TclEmitInstInt4( INST_LIST, i-3, envPtr);
|
||||
TclEmitInstInt4( INST_LIST, i - 3, envPtr);
|
||||
|
||||
if (idx == TCL_INDEX_START) {
|
||||
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
|
||||
@@ -1439,7 +1441,7 @@ TclCompileLinsertCmd(
|
||||
}
|
||||
TclEmitInstInt4( INST_OVER, 1, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
|
||||
TclEmitInt4( idx-1, envPtr);
|
||||
TclEmitInt4( idx - 1, envPtr);
|
||||
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
|
||||
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
|
||||
TclEmitInt4( TCL_INDEX_END, envPtr);
|
||||
@@ -2234,7 +2236,7 @@ TclCompileRegexpCmd(
|
||||
}
|
||||
|
||||
if (!simple) {
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -2242,7 +2244,7 @@ TclCompileRegexpCmd(
|
||||
*/
|
||||
|
||||
varTokenPtr = TokenAfter(varTokenPtr);
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
|
||||
CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);
|
||||
|
||||
if (simple) {
|
||||
if (exact && !nocase) {
|
||||
@@ -2426,7 +2428,7 @@ TclCompileRegsubCmd(
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
bytes = TclGetStringFromObj(replacementObj, &len);
|
||||
PushLiteral(envPtr, bytes, len);
|
||||
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2);
|
||||
CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2);
|
||||
TclEmitOpcode( INST_STR_MAP, envPtr);
|
||||
|
||||
done:
|
||||
@@ -2555,7 +2557,7 @@ TclCompileReturnCmd(
|
||||
*/
|
||||
|
||||
if (explicitResult) {
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
|
||||
} else {
|
||||
/*
|
||||
* No explict result argument, so default result is empty string.
|
||||
@@ -2633,7 +2635,7 @@ TclCompileReturnCmd(
|
||||
*/
|
||||
|
||||
if (explicitResult) {
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
|
||||
CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
|
||||
} else {
|
||||
PushStringLiteral(envPtr, "");
|
||||
}
|
||||
@@ -2864,12 +2866,12 @@ TclCompileVariableCmd(
|
||||
CompileWord(envPtr, varTokenPtr, interp, i);
|
||||
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
|
||||
|
||||
if (i+1 < numWords) {
|
||||
if (i + 1 < numWords) {
|
||||
/*
|
||||
* A value has been given: set the variable, pop the value
|
||||
*/
|
||||
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i+1);
|
||||
CompileWord(envPtr, valueTokenPtr, interp, i + 1);
|
||||
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
|
||||
TclEmitOpcode( INST_POP, envPtr);
|
||||
}
|
||||
@@ -2945,7 +2947,7 @@ IndexTailVarIfKnown(
|
||||
tailName = TclGetStringFromObj(tailPtr, &len);
|
||||
|
||||
if (len) {
|
||||
if (*(tailName+len-1) == ')') {
|
||||
if (*(tailName + len - 1) == ')') {
|
||||
/*
|
||||
* Possible array: bail out
|
||||
*/
|
||||
@@ -2959,7 +2961,7 @@ IndexTailVarIfKnown(
|
||||
*/
|
||||
|
||||
for (p = tailName + len -1; p > tailName; p--) {
|
||||
if ((*p == ':') && (*(p-1) == ':')) {
|
||||
if ((*p == ':') && (*(p - 1) == ':')) {
|
||||
p++;
|
||||
break;
|
||||
}
|
||||
|
||||
@@ -22,7 +22,7 @@
|
||||
* The tree is composed of OpNodes.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct OpNode {
|
||||
int left; /* "Pointer" to the left operand. */
|
||||
int right; /* "Pointer" to the right operand. */
|
||||
union {
|
||||
|
||||
+22
-4
@@ -129,6 +129,10 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
{"jumpFalse4", 5, -1, 1, {OPERAND_OFFSET4}},
|
||||
/* Jump relative to (pc + op4) if stktop expr object is false */
|
||||
|
||||
{"lor", 1, -1, 0, {OPERAND_NONE}},
|
||||
/* Logical or: push (stknext || stktop) */
|
||||
{"land", 1, -1, 0, {OPERAND_NONE}},
|
||||
/* Logical and: push (stknext && stktop) */
|
||||
{"bitor", 1, -1, 0, {OPERAND_NONE}},
|
||||
/* Bitwise or: push (stknext | stktop) */
|
||||
{"bitxor", 1, -1, 0, {OPERAND_NONE}},
|
||||
@@ -169,6 +173,10 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
/* Bitwise not: push ~stktop */
|
||||
{"not", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* Logical not: push !stktop */
|
||||
{"callBuiltinFunc1", 2, 1, 1, {OPERAND_UINT1}},
|
||||
/* Call builtin math function with index op1; any args are on stk */
|
||||
{"callFunc1", 2, INT_MIN, 1, {OPERAND_UINT1}},
|
||||
/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
|
||||
{"tryCvtToNumeric", 1, 0, 0, {OPERAND_NONE}},
|
||||
/* Try converting stktop to first int then double if possible. */
|
||||
|
||||
@@ -178,6 +186,13 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
/* Skip to next iteration of closest enclosing loop; if none, return
|
||||
* TCL_CONTINUE code. */
|
||||
|
||||
{"foreach_start4", 5, 0, 1, {OPERAND_AUX4}},
|
||||
/* Initialize execution of a foreach loop. Operand is aux data index
|
||||
* of the ForeachInfo structure for the foreach command. */
|
||||
{"foreach_step4", 5, +1, 1, {OPERAND_AUX4}},
|
||||
/* "Step" or begin next iteration of foreach loop. Push 0 if to
|
||||
* terminate loop, else push 1. */
|
||||
|
||||
{"beginCatch4", 5, 0, 1, {OPERAND_UINT4}},
|
||||
/* Record start of catch with the operand's exception index. Push the
|
||||
* current stack depth onto a special catch stack. */
|
||||
@@ -325,6 +340,9 @@ InstructionDesc const tclInstructionTable[] = {
|
||||
{"dictNext", 5, +3, 1, {OPERAND_LVT4}},
|
||||
/* Get the next iteration from the iterator in op4's local scalar.
|
||||
* Stack: ... => ... value key doneBool */
|
||||
{"dictDone", 5, 0, 1, {OPERAND_LVT4}},
|
||||
/* Terminate the iterator in op4's local scalar. Use unsetScalar
|
||||
* instead (with 0 for flags). */
|
||||
{"dictUpdateStart", 9, 0, 2, {OPERAND_LVT4, OPERAND_AUX4}},
|
||||
/* Create the variables (described in the aux data referred to by the
|
||||
* second immediate argument) to mirror the state of the dictionary in
|
||||
@@ -835,8 +853,8 @@ TclSetByteCodeFromAny(
|
||||
* instruction generator boundaries.
|
||||
*/
|
||||
|
||||
if (iPtr->optimizer) {
|
||||
(iPtr->optimizer)(&compEnv);
|
||||
if (iPtr->extra.optimizer) {
|
||||
(iPtr->extra.optimizer)(&compEnv);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1114,7 +1132,7 @@ CleanupByteCode(
|
||||
}
|
||||
}
|
||||
|
||||
if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
|
||||
if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
|
||||
TclFreeLocalCache(interp, codePtr->localCachePtr);
|
||||
}
|
||||
|
||||
@@ -1410,7 +1428,7 @@ TclInitCompileEnv(
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL);
|
||||
assert(tclInstructionTable[LAST_INST_OPCODE+1].name == NULL);
|
||||
|
||||
envPtr->iPtr = iPtr;
|
||||
envPtr->source = stringPtr;
|
||||
|
||||
+263
-243
@@ -87,7 +87,7 @@ typedef enum {
|
||||
* to a catch PC offset. */
|
||||
} ExceptionRangeType;
|
||||
|
||||
typedef struct {
|
||||
typedef struct ExceptionRange {
|
||||
ExceptionRangeType type; /* The kind of ExceptionRange. */
|
||||
int nestingLevel; /* Static depth of the exception range. Used
|
||||
* to find the most deeply-nested range
|
||||
@@ -162,7 +162,7 @@ typedef struct ExceptionAux {
|
||||
* source offset is not monotonic.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct CmdLocation {
|
||||
int codeOffset; /* Offset of first byte of command code. */
|
||||
int numCodeBytes; /* Number of bytes for command's code. */
|
||||
int srcOffset; /* Offset of first char of the command. */
|
||||
@@ -180,7 +180,7 @@ typedef struct {
|
||||
* frame and associated information, like the path of a sourced file.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ECL {
|
||||
int srcOffset; /* Command location to find the entry. */
|
||||
int nline; /* Number of words in the command */
|
||||
int *line; /* Line information for all words in the
|
||||
@@ -190,7 +190,7 @@ typedef struct {
|
||||
* lines. */
|
||||
} ECL;
|
||||
|
||||
typedef struct {
|
||||
typedef struct ExtCmdLoc {
|
||||
int type; /* Context type. */
|
||||
int start; /* Starting line for compiled script. Needed
|
||||
* for the extended recompile check in
|
||||
@@ -417,7 +417,7 @@ typedef struct ByteCode {
|
||||
* procs are specific to an interpreter so the
|
||||
* code emitted will depend on the
|
||||
* interpreter. */
|
||||
size_t compileEpoch; /* Value of iPtr->compileEpoch when this
|
||||
unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
|
||||
* ByteCode was compiled. Used to invalidate
|
||||
* code when, e.g., commands with compile
|
||||
* procs are redefined. */
|
||||
@@ -425,11 +425,11 @@ typedef struct ByteCode {
|
||||
* compiled. If the code is executed if a
|
||||
* different namespace, it must be
|
||||
* recompiled. */
|
||||
size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this
|
||||
unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this
|
||||
* ByteCode was compiled. Used to invalidate
|
||||
* code when new namespace resolution rules
|
||||
* are put into effect. */
|
||||
size_t refCount; /* Reference count: set 1 when created plus 1
|
||||
unsigned int refCount; /* Reference count: set 1 when created plus 1
|
||||
* for each execution of the code currently
|
||||
* active. This structure can be freed when
|
||||
* refCount becomes zero. */
|
||||
@@ -519,292 +519,312 @@ typedef struct ByteCode {
|
||||
* Opcodes for the Tcl bytecode instructions. These must correspond to the
|
||||
* entries in the table of instruction descriptions, tclInstructionTable, in
|
||||
* tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
|
||||
* INST_BITOR) must match the entries in the array operatorStrings in
|
||||
* INST_LOR) must match the entries in the array operatorStrings in
|
||||
* tclExecute.c.
|
||||
*/
|
||||
|
||||
enum TclInstruction {
|
||||
/* Opcodes 0 to 9 */
|
||||
#define INST_DONE 0
|
||||
#define INST_PUSH1 1
|
||||
#define INST_PUSH4 2
|
||||
#define INST_POP 3
|
||||
#define INST_DUP 4
|
||||
#define INST_STR_CONCAT1 5
|
||||
#define INST_INVOKE_STK1 6
|
||||
#define INST_INVOKE_STK4 7
|
||||
#define INST_EVAL_STK 8
|
||||
#define INST_EXPR_STK 9
|
||||
|
||||
/* Opcodes 0 to 9 */
|
||||
INST_DONE = 0,
|
||||
INST_PUSH1,
|
||||
INST_PUSH4,
|
||||
INST_POP,
|
||||
INST_DUP,
|
||||
INST_STR_CONCAT1,
|
||||
INST_INVOKE_STK1,
|
||||
INST_INVOKE_STK4,
|
||||
INST_EVAL_STK,
|
||||
INST_EXPR_STK,
|
||||
/* Opcodes 10 to 23 */
|
||||
#define INST_LOAD_SCALAR1 10
|
||||
#define INST_LOAD_SCALAR4 11
|
||||
#define INST_LOAD_SCALAR_STK 12
|
||||
#define INST_LOAD_ARRAY1 13
|
||||
#define INST_LOAD_ARRAY4 14
|
||||
#define INST_LOAD_ARRAY_STK 15
|
||||
#define INST_LOAD_STK 16
|
||||
#define INST_STORE_SCALAR1 17
|
||||
#define INST_STORE_SCALAR4 18
|
||||
#define INST_STORE_SCALAR_STK 19
|
||||
#define INST_STORE_ARRAY1 20
|
||||
#define INST_STORE_ARRAY4 21
|
||||
#define INST_STORE_ARRAY_STK 22
|
||||
#define INST_STORE_STK 23
|
||||
|
||||
/* Opcodes 10 to 23 */
|
||||
INST_LOAD_SCALAR1,
|
||||
INST_LOAD_SCALAR4,
|
||||
INST_LOAD_SCALAR_STK,
|
||||
INST_LOAD_ARRAY1,
|
||||
INST_LOAD_ARRAY4,
|
||||
INST_LOAD_ARRAY_STK,
|
||||
INST_LOAD_STK,
|
||||
INST_STORE_SCALAR1,
|
||||
INST_STORE_SCALAR4,
|
||||
INST_STORE_SCALAR_STK,
|
||||
INST_STORE_ARRAY1,
|
||||
INST_STORE_ARRAY4,
|
||||
INST_STORE_ARRAY_STK,
|
||||
INST_STORE_STK,
|
||||
/* Opcodes 24 to 33 */
|
||||
#define INST_INCR_SCALAR1 24
|
||||
#define INST_INCR_SCALAR_STK 25
|
||||
#define INST_INCR_ARRAY1 26
|
||||
#define INST_INCR_ARRAY_STK 27
|
||||
#define INST_INCR_STK 28
|
||||
#define INST_INCR_SCALAR1_IMM 29
|
||||
#define INST_INCR_SCALAR_STK_IMM 30
|
||||
#define INST_INCR_ARRAY1_IMM 31
|
||||
#define INST_INCR_ARRAY_STK_IMM 32
|
||||
#define INST_INCR_STK_IMM 33
|
||||
|
||||
/* Opcodes 24 to 33 */
|
||||
INST_INCR_SCALAR1,
|
||||
INST_INCR_SCALAR_STK,
|
||||
INST_INCR_ARRAY1,
|
||||
INST_INCR_ARRAY_STK,
|
||||
INST_INCR_STK,
|
||||
INST_INCR_SCALAR1_IMM,
|
||||
INST_INCR_SCALAR_STK_IMM,
|
||||
INST_INCR_ARRAY1_IMM,
|
||||
INST_INCR_ARRAY_STK_IMM,
|
||||
INST_INCR_STK_IMM,
|
||||
/* Opcodes 34 to 39 */
|
||||
#define INST_JUMP1 34
|
||||
#define INST_JUMP4 35
|
||||
#define INST_JUMP_TRUE1 36
|
||||
#define INST_JUMP_TRUE4 37
|
||||
#define INST_JUMP_FALSE1 38
|
||||
#define INST_JUMP_FALSE4 39
|
||||
|
||||
/* Opcodes 34 to 39 */
|
||||
INST_JUMP1,
|
||||
INST_JUMP4,
|
||||
INST_JUMP_TRUE1,
|
||||
INST_JUMP_TRUE4,
|
||||
INST_JUMP_FALSE1,
|
||||
INST_JUMP_FALSE4,
|
||||
/* Opcodes 40 to 64 */
|
||||
#define INST_LOR 40
|
||||
#define INST_LAND 41
|
||||
#define INST_BITOR 42
|
||||
#define INST_BITXOR 43
|
||||
#define INST_BITAND 44
|
||||
#define INST_EQ 45
|
||||
#define INST_NEQ 46
|
||||
#define INST_LT 47
|
||||
#define INST_GT 48
|
||||
#define INST_LE 49
|
||||
#define INST_GE 50
|
||||
#define INST_LSHIFT 51
|
||||
#define INST_RSHIFT 52
|
||||
#define INST_ADD 53
|
||||
#define INST_SUB 54
|
||||
#define INST_MULT 55
|
||||
#define INST_DIV 56
|
||||
#define INST_MOD 57
|
||||
#define INST_UPLUS 58
|
||||
#define INST_UMINUS 59
|
||||
#define INST_BITNOT 60
|
||||
#define INST_LNOT 61
|
||||
#define INST_CALL_BUILTIN_FUNC1 62
|
||||
#define INST_CALL_FUNC1 63
|
||||
#define INST_TRY_CVT_TO_NUMERIC 64
|
||||
|
||||
/* Opcodes 42 to 64 */
|
||||
INST_BITOR,
|
||||
INST_BITXOR,
|
||||
INST_BITAND,
|
||||
INST_EQ,
|
||||
INST_NEQ,
|
||||
INST_LT,
|
||||
INST_GT,
|
||||
INST_LE,
|
||||
INST_GE,
|
||||
INST_LSHIFT,
|
||||
INST_RSHIFT,
|
||||
INST_ADD,
|
||||
INST_SUB,
|
||||
INST_MULT,
|
||||
INST_DIV,
|
||||
INST_MOD,
|
||||
INST_UPLUS,
|
||||
INST_UMINUS,
|
||||
INST_BITNOT,
|
||||
INST_LNOT,
|
||||
INST_TRY_CVT_TO_NUMERIC,
|
||||
/* Opcodes 65 to 66 */
|
||||
#define INST_BREAK 65
|
||||
#define INST_CONTINUE 66
|
||||
|
||||
/* Opcodes 65 to 66 */
|
||||
INST_BREAK,
|
||||
INST_CONTINUE,
|
||||
/* Opcodes 67 to 68 */
|
||||
#define INST_FOREACH_START4 67 /* DEPRECATED */
|
||||
#define INST_FOREACH_STEP4 68 /* DEPRECATED */
|
||||
|
||||
/* Opcodes 69 to 72 */
|
||||
INST_BEGIN_CATCH4,
|
||||
INST_END_CATCH,
|
||||
INST_PUSH_RESULT,
|
||||
INST_PUSH_RETURN_CODE,
|
||||
/* Opcodes 69 to 72 */
|
||||
#define INST_BEGIN_CATCH4 69
|
||||
#define INST_END_CATCH 70
|
||||
#define INST_PUSH_RESULT 71
|
||||
#define INST_PUSH_RETURN_CODE 72
|
||||
|
||||
/* Opcodes 73 to 78 */
|
||||
INST_STR_EQ,
|
||||
INST_STR_NEQ,
|
||||
INST_STR_CMP,
|
||||
INST_STR_LEN,
|
||||
INST_STR_INDEX,
|
||||
INST_STR_MATCH,
|
||||
/* Opcodes 73 to 78 */
|
||||
#define INST_STR_EQ 73
|
||||
#define INST_STR_NEQ 74
|
||||
#define INST_STR_CMP 75
|
||||
#define INST_STR_LEN 76
|
||||
#define INST_STR_INDEX 77
|
||||
#define INST_STR_MATCH 78
|
||||
|
||||
/* Opcodes 79 to 81 */
|
||||
INST_LIST,
|
||||
INST_LIST_INDEX,
|
||||
INST_LIST_LENGTH,
|
||||
/* Opcodes 78 to 81 */
|
||||
#define INST_LIST 79
|
||||
#define INST_LIST_INDEX 80
|
||||
#define INST_LIST_LENGTH 81
|
||||
|
||||
/* Opcodes 82 to 87 */
|
||||
INST_APPEND_SCALAR1,
|
||||
INST_APPEND_SCALAR4,
|
||||
INST_APPEND_ARRAY1,
|
||||
INST_APPEND_ARRAY4,
|
||||
INST_APPEND_ARRAY_STK,
|
||||
INST_APPEND_STK,
|
||||
/* Opcodes 82 to 87 */
|
||||
#define INST_APPEND_SCALAR1 82
|
||||
#define INST_APPEND_SCALAR4 83
|
||||
#define INST_APPEND_ARRAY1 84
|
||||
#define INST_APPEND_ARRAY4 85
|
||||
#define INST_APPEND_ARRAY_STK 86
|
||||
#define INST_APPEND_STK 87
|
||||
|
||||
/* Opcodes 88 to 93 */
|
||||
INST_LAPPEND_SCALAR1,
|
||||
INST_LAPPEND_SCALAR4,
|
||||
INST_LAPPEND_ARRAY1,
|
||||
INST_LAPPEND_ARRAY4,
|
||||
INST_LAPPEND_ARRAY_STK,
|
||||
INST_LAPPEND_STK,
|
||||
/* Opcodes 88 to 93 */
|
||||
#define INST_LAPPEND_SCALAR1 88
|
||||
#define INST_LAPPEND_SCALAR4 89
|
||||
#define INST_LAPPEND_ARRAY1 90
|
||||
#define INST_LAPPEND_ARRAY4 91
|
||||
#define INST_LAPPEND_ARRAY_STK 92
|
||||
#define INST_LAPPEND_STK 93
|
||||
|
||||
/* TIP #22 - LINDEX operator with flat arg list */
|
||||
INST_LIST_INDEX_MULTI,
|
||||
/* TIP #22 - LINDEX operator with flat arg list */
|
||||
|
||||
/*
|
||||
* TIP #33 - 'lset' command. Code gen also required a Forth-like
|
||||
* OVER operation.
|
||||
*/
|
||||
INST_OVER,
|
||||
INST_LSET_LIST,
|
||||
INST_LSET_FLAT,
|
||||
#define INST_LIST_INDEX_MULTI 94
|
||||
|
||||
/* TIP#90 - 'return' command. */
|
||||
INST_RETURN_IMM,
|
||||
/*
|
||||
* TIP #33 - 'lset' command. Code gen also required a Forth-like
|
||||
* OVER operation.
|
||||
*/
|
||||
|
||||
/* TIP#123 - exponentiation operator. */
|
||||
INST_EXPON,
|
||||
#define INST_OVER 95
|
||||
#define INST_LSET_LIST 96
|
||||
#define INST_LSET_FLAT 97
|
||||
|
||||
/* TIP #157 - {*}... (word expansion) language syntax support. */
|
||||
INST_EXPAND_START,
|
||||
INST_EXPAND_STKTOP,
|
||||
INST_INVOKE_EXPANDED,
|
||||
/* TIP#90 - 'return' command. */
|
||||
|
||||
/*
|
||||
* TIP #57 - 'lassign' command. Code generation requires immediate
|
||||
* LINDEX and LRANGE operators.
|
||||
*/
|
||||
INST_LIST_INDEX_IMM,
|
||||
INST_LIST_RANGE_IMM,
|
||||
INST_START_CMD,
|
||||
INST_LIST_IN,
|
||||
INST_LIST_NOT_IN,
|
||||
INST_PUSH_RETURN_OPTIONS,
|
||||
INST_RETURN_STK,
|
||||
#define INST_RETURN_IMM 98
|
||||
|
||||
/*
|
||||
* Dictionary (TIP#111) related commands.
|
||||
*/
|
||||
INST_DICT_GET,
|
||||
INST_DICT_SET,
|
||||
INST_DICT_UNSET,
|
||||
INST_DICT_INCR_IMM,
|
||||
INST_DICT_APPEND,
|
||||
INST_DICT_LAPPEND,
|
||||
INST_DICT_FIRST,
|
||||
INST_DICT_NEXT,
|
||||
INST_DICT_UPDATE_START,
|
||||
INST_DICT_UPDATE_END,
|
||||
/* TIP#123 - exponentiation operator. */
|
||||
|
||||
/*
|
||||
* Instruction to support jumps defined by tables (instead of the classic
|
||||
* [switch] technique of chained comparisons).
|
||||
*/
|
||||
INST_JUMP_TABLE,
|
||||
#define INST_EXPON 99
|
||||
|
||||
/*
|
||||
* Instructions to support compilation of global, variable, upvar and
|
||||
* [namespace upvar].
|
||||
*/
|
||||
INST_UPVAR,
|
||||
INST_NSUPVAR,
|
||||
INST_VARIABLE,
|
||||
/* TIP #157 - {*}... (word expansion) language syntax support. */
|
||||
|
||||
/* Instruction to support compiling syntax error to bytecode */
|
||||
INST_SYNTAX,
|
||||
#define INST_EXPAND_START 100
|
||||
#define INST_EXPAND_STKTOP 101
|
||||
#define INST_INVOKE_EXPANDED 102
|
||||
|
||||
/* Instruction to reverse N items on top of stack */
|
||||
INST_REVERSE,
|
||||
/*
|
||||
* TIP #57 - 'lassign' command. Code generation requires immediate
|
||||
* LINDEX and LRANGE operators.
|
||||
*/
|
||||
|
||||
/* regexp instruction */
|
||||
INST_REGEXP,
|
||||
#define INST_LIST_INDEX_IMM 103
|
||||
#define INST_LIST_RANGE_IMM 104
|
||||
|
||||
/* For [info exists] compilation */
|
||||
INST_EXIST_SCALAR,
|
||||
INST_EXIST_ARRAY,
|
||||
INST_EXIST_ARRAY_STK,
|
||||
INST_EXIST_STK,
|
||||
#define INST_START_CMD 105
|
||||
|
||||
/* For [subst] compilation */
|
||||
INST_NOP,
|
||||
INST_RETURN_CODE_BRANCH,
|
||||
#define INST_LIST_IN 106
|
||||
#define INST_LIST_NOT_IN 107
|
||||
|
||||
/* For [unset] compilation */
|
||||
INST_UNSET_SCALAR,
|
||||
INST_UNSET_ARRAY,
|
||||
INST_UNSET_ARRAY_STK,
|
||||
INST_UNSET_STK,
|
||||
#define INST_PUSH_RETURN_OPTIONS 108
|
||||
#define INST_RETURN_STK 109
|
||||
|
||||
/* For [dict with], [dict exists], [dict create] and [dict merge] */
|
||||
INST_DICT_EXPAND,
|
||||
INST_DICT_RECOMBINE_STK,
|
||||
INST_DICT_RECOMBINE_IMM,
|
||||
INST_DICT_EXISTS,
|
||||
INST_DICT_VERIFY,
|
||||
/*
|
||||
* Dictionary (TIP#111) related commands.
|
||||
*/
|
||||
|
||||
/* For [string map] and [regsub] compilation */
|
||||
INST_STR_MAP,
|
||||
INST_STR_FIND,
|
||||
INST_STR_FIND_LAST,
|
||||
INST_STR_RANGE_IMM,
|
||||
INST_STR_RANGE,
|
||||
#define INST_DICT_GET 110
|
||||
#define INST_DICT_SET 111
|
||||
#define INST_DICT_UNSET 112
|
||||
#define INST_DICT_INCR_IMM 113
|
||||
#define INST_DICT_APPEND 114
|
||||
#define INST_DICT_LAPPEND 115
|
||||
#define INST_DICT_FIRST 116
|
||||
#define INST_DICT_NEXT 117
|
||||
#define INST_DICT_DONE 118
|
||||
#define INST_DICT_UPDATE_START 119
|
||||
#define INST_DICT_UPDATE_END 120
|
||||
|
||||
/* For operations to do with coroutines and other NRE-manipulators */
|
||||
INST_YIELD,
|
||||
INST_COROUTINE_NAME,
|
||||
INST_TAILCALL,
|
||||
/*
|
||||
* Instruction to support jumps defined by tables (instead of the classic
|
||||
* [switch] technique of chained comparisons).
|
||||
*/
|
||||
|
||||
/* For compilation of basic information operations */
|
||||
INST_NS_CURRENT,
|
||||
INST_INFO_LEVEL_NUM,
|
||||
INST_INFO_LEVEL_ARGS,
|
||||
INST_RESOLVE_COMMAND,
|
||||
#define INST_JUMP_TABLE 121
|
||||
|
||||
/* For compilation relating to TclOO */
|
||||
INST_TCLOO_SELF,
|
||||
INST_TCLOO_CLASS,
|
||||
INST_TCLOO_NS,
|
||||
INST_TCLOO_IS_OBJECT,
|
||||
/*
|
||||
* Instructions to support compilation of global, variable, upvar and
|
||||
* [namespace upvar].
|
||||
*/
|
||||
|
||||
/* For compilation of [array] subcommands */
|
||||
INST_ARRAY_EXISTS_STK,
|
||||
INST_ARRAY_EXISTS_IMM,
|
||||
INST_ARRAY_MAKE_STK,
|
||||
INST_ARRAY_MAKE_IMM,
|
||||
#define INST_UPVAR 122
|
||||
#define INST_NSUPVAR 123
|
||||
#define INST_VARIABLE 124
|
||||
|
||||
INST_INVOKE_REPLACE,
|
||||
/* Instruction to support compiling syntax error to bytecode */
|
||||
|
||||
INST_LIST_CONCAT,
|
||||
#define INST_SYNTAX 125
|
||||
|
||||
INST_EXPAND_DROP,
|
||||
/* Instruction to reverse N items on top of stack */
|
||||
|
||||
/* New foreach implementation */
|
||||
INST_FOREACH_START,
|
||||
INST_FOREACH_STEP,
|
||||
INST_FOREACH_END,
|
||||
INST_LMAP_COLLECT,
|
||||
#define INST_REVERSE 126
|
||||
|
||||
/* For compilation of [string trim] and related */
|
||||
INST_STR_TRIM,
|
||||
INST_STR_TRIM_LEFT,
|
||||
INST_STR_TRIM_RIGHT,
|
||||
/* regexp instruction */
|
||||
|
||||
INST_CONCAT_STK,
|
||||
#define INST_REGEXP 127
|
||||
|
||||
INST_STR_UPPER,
|
||||
INST_STR_LOWER,
|
||||
INST_STR_TITLE,
|
||||
INST_STR_REPLACE,
|
||||
/* For [info exists] compilation */
|
||||
#define INST_EXIST_SCALAR 128
|
||||
#define INST_EXIST_ARRAY 129
|
||||
#define INST_EXIST_ARRAY_STK 130
|
||||
#define INST_EXIST_STK 131
|
||||
|
||||
INST_ORIGIN_COMMAND,
|
||||
/* For [subst] compilation */
|
||||
#define INST_NOP 132
|
||||
#define INST_RETURN_CODE_BRANCH 133
|
||||
|
||||
INST_TCLOO_NEXT,
|
||||
INST_TCLOO_NEXT_CLASS,
|
||||
/* For [unset] compilation */
|
||||
#define INST_UNSET_SCALAR 134
|
||||
#define INST_UNSET_ARRAY 135
|
||||
#define INST_UNSET_ARRAY_STK 136
|
||||
#define INST_UNSET_STK 137
|
||||
|
||||
INST_YIELD_TO_INVOKE,
|
||||
/* For [dict with], [dict exists], [dict create] and [dict merge] */
|
||||
#define INST_DICT_EXPAND 138
|
||||
#define INST_DICT_RECOMBINE_STK 139
|
||||
#define INST_DICT_RECOMBINE_IMM 140
|
||||
#define INST_DICT_EXISTS 141
|
||||
#define INST_DICT_VERIFY 142
|
||||
|
||||
INST_NUM_TYPE,
|
||||
INST_TRY_CVT_TO_BOOLEAN,
|
||||
INST_STR_CLASS,
|
||||
/* For [string map] and [regsub] compilation */
|
||||
#define INST_STR_MAP 143
|
||||
#define INST_STR_FIND 144
|
||||
#define INST_STR_FIND_LAST 145
|
||||
#define INST_STR_RANGE_IMM 146
|
||||
#define INST_STR_RANGE 147
|
||||
|
||||
INST_LAPPEND_LIST,
|
||||
INST_LAPPEND_LIST_ARRAY,
|
||||
INST_LAPPEND_LIST_ARRAY_STK,
|
||||
INST_LAPPEND_LIST_STK,
|
||||
/* For operations to do with coroutines and other NRE-manipulators */
|
||||
#define INST_YIELD 148
|
||||
#define INST_COROUTINE_NAME 149
|
||||
#define INST_TAILCALL 150
|
||||
|
||||
INST_CLOCK_READ,
|
||||
/* For compilation of basic information operations */
|
||||
#define INST_NS_CURRENT 151
|
||||
#define INST_INFO_LEVEL_NUM 152
|
||||
#define INST_INFO_LEVEL_ARGS 153
|
||||
#define INST_RESOLVE_COMMAND 154
|
||||
|
||||
/* The last opcode */
|
||||
LAST_INST_OPCODE
|
||||
};
|
||||
/* For compilation relating to TclOO */
|
||||
#define INST_TCLOO_SELF 155
|
||||
#define INST_TCLOO_CLASS 156
|
||||
#define INST_TCLOO_NS 157
|
||||
#define INST_TCLOO_IS_OBJECT 158
|
||||
|
||||
/* For compilation of [array] subcommands */
|
||||
#define INST_ARRAY_EXISTS_STK 159
|
||||
#define INST_ARRAY_EXISTS_IMM 160
|
||||
#define INST_ARRAY_MAKE_STK 161
|
||||
#define INST_ARRAY_MAKE_IMM 162
|
||||
|
||||
#define INST_INVOKE_REPLACE 163
|
||||
|
||||
#define INST_LIST_CONCAT 164
|
||||
|
||||
#define INST_EXPAND_DROP 165
|
||||
|
||||
/* New foreach implementation */
|
||||
#define INST_FOREACH_START 166
|
||||
#define INST_FOREACH_STEP 167
|
||||
#define INST_FOREACH_END 168
|
||||
#define INST_LMAP_COLLECT 169
|
||||
|
||||
/* For compilation of [string trim] and related */
|
||||
#define INST_STR_TRIM 170
|
||||
#define INST_STR_TRIM_LEFT 171
|
||||
#define INST_STR_TRIM_RIGHT 172
|
||||
|
||||
#define INST_CONCAT_STK 173
|
||||
|
||||
#define INST_STR_UPPER 174
|
||||
#define INST_STR_LOWER 175
|
||||
#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
|
||||
|
||||
#define INST_LAPPEND_LIST 185
|
||||
#define INST_LAPPEND_LIST_ARRAY 186
|
||||
#define INST_LAPPEND_LIST_ARRAY_STK 187
|
||||
#define INST_LAPPEND_LIST_STK 188
|
||||
|
||||
#define INST_CLOCK_READ 189
|
||||
|
||||
/* The last opcode */
|
||||
#define LAST_INST_OPCODE 189
|
||||
|
||||
/*
|
||||
* Table describing the Tcl bytecode instructions: their name (for displaying
|
||||
|
||||
+1
-1
@@ -31,7 +31,7 @@
|
||||
* the (Tcl_Interp *) in which it is stored, and the encoding.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct QCCD {
|
||||
Tcl_Obj *pkg;
|
||||
Tcl_Interp *interp;
|
||||
char *encoding;
|
||||
|
||||
+190
-94
@@ -118,7 +118,9 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
|
||||
/* 21 */
|
||||
EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
|
||||
int line);
|
||||
/* Slot 22 is reserved */
|
||||
/* 22 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
|
||||
int line);
|
||||
/* 23 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
|
||||
int length, const char *file, int line);
|
||||
@@ -128,7 +130,9 @@ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
|
||||
/* 25 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
|
||||
const char *file, int line);
|
||||
/* Slot 26 is reserved */
|
||||
/* 26 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
|
||||
int line);
|
||||
/* 27 */
|
||||
EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
|
||||
/* 28 */
|
||||
@@ -167,7 +171,7 @@ EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr, long *longPtr);
|
||||
/* 40 */
|
||||
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
|
||||
EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName);
|
||||
/* 41 */
|
||||
EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
|
||||
/* 42 */
|
||||
@@ -193,21 +197,25 @@ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp,
|
||||
EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr, int first, int count,
|
||||
int objc, Tcl_Obj *const objv[]);
|
||||
/* Slot 49 is reserved */
|
||||
/* 49 */
|
||||
EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
|
||||
/* 50 */
|
||||
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
|
||||
int length);
|
||||
/* 51 */
|
||||
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
|
||||
/* Slot 52 is reserved */
|
||||
/* 52 */
|
||||
EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue);
|
||||
/* 53 */
|
||||
EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
|
||||
/* Slot 54 is reserved */
|
||||
/* 54 */
|
||||
EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue);
|
||||
/* 55 */
|
||||
EXTERN Tcl_Obj * Tcl_NewObj(void);
|
||||
/* 56 */
|
||||
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
|
||||
/* Slot 57 is reserved */
|
||||
/* 57 */
|
||||
EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
|
||||
/* 58 */
|
||||
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
|
||||
/* 59 */
|
||||
@@ -215,11 +223,13 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
|
||||
const unsigned char *bytes, int length);
|
||||
/* 60 */
|
||||
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
|
||||
/* Slot 61 is reserved */
|
||||
/* 61 */
|
||||
EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
|
||||
/* 62 */
|
||||
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
/* Slot 63 is reserved */
|
||||
/* 63 */
|
||||
EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
|
||||
/* 64 */
|
||||
EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
|
||||
/* 65 */
|
||||
@@ -251,7 +261,9 @@ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async);
|
||||
EXTERN int Tcl_AsyncReady(void);
|
||||
/* 76 */
|
||||
EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
|
||||
/* Slot 77 is reserved */
|
||||
/* 77 */
|
||||
TCL_DEPRECATED("Use Tcl_UtfBackslash")
|
||||
char Tcl_Backslash(const char *src, int *readPtr);
|
||||
/* 78 */
|
||||
EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
|
||||
const char *optionName,
|
||||
@@ -309,7 +321,12 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
|
||||
ClientData clientData);
|
||||
/* 94 */
|
||||
EXTERN Tcl_Interp * Tcl_CreateInterp(void);
|
||||
/* Slot 95 is reserved */
|
||||
/* 95 */
|
||||
TCL_DEPRECATED("")
|
||||
void Tcl_CreateMathFunc(Tcl_Interp *interp,
|
||||
const char *name, int numArgs,
|
||||
Tcl_ValueType *argTypes, Tcl_MathProc *proc,
|
||||
ClientData clientData);
|
||||
/* 96 */
|
||||
EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_ObjCmdProc *proc,
|
||||
@@ -404,7 +421,8 @@ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
|
||||
/* 130 */
|
||||
EXTERN int Tcl_EvalFile(Tcl_Interp *interp,
|
||||
const char *fileName);
|
||||
/* Slot 131 is reserved */
|
||||
/* 131 */
|
||||
EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
/* 132 */
|
||||
EXTERN void Tcl_EventuallyFree(ClientData clientData,
|
||||
Tcl_FreeProc *freeProc);
|
||||
@@ -483,7 +501,7 @@ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
|
||||
Tcl_Channel chan, const char *optionName,
|
||||
Tcl_DString *dsPtr);
|
||||
/* 158 */
|
||||
EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
|
||||
EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
|
||||
/* 159 */
|
||||
EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_CmdInfo *infoPtr);
|
||||
@@ -539,7 +557,9 @@ EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
|
||||
/* 177 */
|
||||
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
|
||||
const char *command);
|
||||
/* Slot 178 is reserved */
|
||||
/* 178 */
|
||||
EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
/* 179 */
|
||||
EXTERN int Tcl_HideCommand(Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
@@ -647,7 +667,9 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
|
||||
/* 219 */
|
||||
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
|
||||
int *flagPtr);
|
||||
/* Slot 220 is reserved */
|
||||
/* 220 */
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
|
||||
/* 221 */
|
||||
EXTERN int Tcl_ServiceAll(void);
|
||||
/* 222 */
|
||||
@@ -717,7 +739,9 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
|
||||
Tcl_PackageInitProc *safeInitProc);
|
||||
/* 245 */
|
||||
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
|
||||
/* Slot 246 is reserved */
|
||||
/* 246 */
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_TellOld(Tcl_Channel chan);
|
||||
/* 247 */
|
||||
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
|
||||
int flags, Tcl_VarTraceProc *proc,
|
||||
@@ -787,8 +811,14 @@ EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
|
||||
EXTERN int Tcl_DumpActiveMemory(const char *fileName);
|
||||
/* 266 */
|
||||
EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
|
||||
/* Slot 267 is reserved */
|
||||
/* Slot 268 is reserved */
|
||||
/* 267 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
void Tcl_AppendResultVA(Tcl_Interp *interp,
|
||||
va_list argList);
|
||||
/* 268 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
|
||||
va_list argList);
|
||||
/* 269 */
|
||||
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
|
||||
/* 270 */
|
||||
@@ -807,11 +837,18 @@ EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
|
||||
/* 274 */
|
||||
EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
|
||||
const char *version, int exact);
|
||||
/* Slot 275 is reserved */
|
||||
/* Slot 276 is reserved */
|
||||
/* 275 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
|
||||
va_list argList);
|
||||
/* 276 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
|
||||
/* 277 */
|
||||
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
|
||||
/* Slot 278 is reserved */
|
||||
/* 278 */
|
||||
TCL_DEPRECATED("see TIP #422")
|
||||
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
|
||||
/* 279 */
|
||||
EXTERN void Tcl_GetVersion(int *major, int *minor,
|
||||
int *patchLevel, int *type);
|
||||
@@ -975,8 +1012,12 @@ EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src,
|
||||
EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
|
||||
/* 340 */
|
||||
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
|
||||
/* Slot 341 is reserved */
|
||||
/* Slot 342 is reserved */
|
||||
/* 341 */
|
||||
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
|
||||
const char * Tcl_GetDefaultEncodingDir(void);
|
||||
/* 342 */
|
||||
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
|
||||
void Tcl_SetDefaultEncodingDir(const char *path);
|
||||
/* 343 */
|
||||
EXTERN void Tcl_AlertNotifier(ClientData clientData);
|
||||
/* 344 */
|
||||
@@ -1010,7 +1051,10 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
|
||||
/* 356 */
|
||||
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *patObj, int flags);
|
||||
/* Slot 357 is reserved */
|
||||
/* 357 */
|
||||
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
|
||||
Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
|
||||
Tcl_Token *tokenPtr, int count);
|
||||
/* 358 */
|
||||
EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
|
||||
/* 359 */
|
||||
@@ -1185,8 +1229,12 @@ EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs,
|
||||
/* 420 */
|
||||
EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
|
||||
const Tcl_UniChar *uniPattern, int nocase);
|
||||
/* Slot 421 is reserved */
|
||||
/* Slot 422 is reserved */
|
||||
/* 421 */
|
||||
EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
|
||||
const void *key);
|
||||
/* 422 */
|
||||
EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
|
||||
const void *key, int *newPtr);
|
||||
/* 423 */
|
||||
EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
|
||||
int keyType, const Tcl_HashKeyType *typePtr);
|
||||
@@ -1224,8 +1272,17 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
|
||||
/* 434 */
|
||||
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
|
||||
int *lengthPtr);
|
||||
/* Slot 435 is reserved */
|
||||
/* Slot 436 is reserved */
|
||||
/* 435 */
|
||||
TCL_DEPRECATED("")
|
||||
int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
|
||||
const char *name, int *numArgsPtr,
|
||||
Tcl_ValueType **argTypesPtr,
|
||||
Tcl_MathProc **procPtr,
|
||||
ClientData *clientDataPtr);
|
||||
/* 436 */
|
||||
TCL_DEPRECATED("")
|
||||
Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
|
||||
const char *pattern);
|
||||
/* 437 */
|
||||
EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
int flags);
|
||||
@@ -1275,7 +1332,7 @@ EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
|
||||
EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
|
||||
Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
|
||||
/* 453 */
|
||||
EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
|
||||
Tcl_Obj **objPtrRef);
|
||||
/* 454 */
|
||||
EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
|
||||
@@ -1336,7 +1393,7 @@ EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr);
|
||||
EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
|
||||
Tcl_Obj *pathPtr);
|
||||
/* 477 */
|
||||
EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
|
||||
EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
|
||||
/* 478 */
|
||||
EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr);
|
||||
/* 479 */
|
||||
@@ -1830,11 +1887,11 @@ typedef struct TclStubs {
|
||||
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
|
||||
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
|
||||
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
|
||||
void (*reserved22)(void);
|
||||
Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
|
||||
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
|
||||
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
|
||||
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
|
||||
void (*reserved26)(void);
|
||||
Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
|
||||
Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
|
||||
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
|
||||
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
|
||||
@@ -1848,7 +1905,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
|
||||
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
|
||||
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
|
||||
const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
|
||||
CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
|
||||
char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
|
||||
void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
|
||||
int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
|
||||
@@ -1857,21 +1914,21 @@ typedef struct TclStubs {
|
||||
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
|
||||
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
|
||||
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
|
||||
void (*reserved49)(void);
|
||||
Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
|
||||
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
|
||||
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
|
||||
void (*reserved52)(void);
|
||||
Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
|
||||
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
|
||||
void (*reserved54)(void);
|
||||
Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
|
||||
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
|
||||
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
|
||||
void (*reserved57)(void);
|
||||
void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
|
||||
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
|
||||
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
|
||||
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
|
||||
void (*reserved61)(void);
|
||||
void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
|
||||
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
|
||||
void (*reserved63)(void);
|
||||
void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
|
||||
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
|
||||
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
|
||||
void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
|
||||
@@ -1885,7 +1942,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
|
||||
int (*tcl_AsyncReady) (void); /* 75 */
|
||||
void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
|
||||
void (*reserved77)(void);
|
||||
TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
|
||||
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
|
||||
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
|
||||
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
|
||||
@@ -1903,7 +1960,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
|
||||
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
|
||||
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
|
||||
void (*reserved95)(void);
|
||||
TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
|
||||
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
|
||||
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
|
||||
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
|
||||
@@ -1939,7 +1996,7 @@ typedef struct TclStubs {
|
||||
const char * (*tcl_ErrnoMsg) (int err); /* 128 */
|
||||
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
|
||||
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
|
||||
void (*reserved131)(void);
|
||||
int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
|
||||
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
|
||||
TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
|
||||
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
|
||||
@@ -1966,7 +2023,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
|
||||
const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
|
||||
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
|
||||
const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
|
||||
CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
|
||||
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
|
||||
const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
|
||||
int (*tcl_GetErrno) (void); /* 161 */
|
||||
@@ -1994,7 +2051,7 @@ typedef struct TclStubs {
|
||||
const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
|
||||
const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
|
||||
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
|
||||
void (*reserved178)(void);
|
||||
int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
|
||||
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
|
||||
int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
|
||||
void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
|
||||
@@ -2036,7 +2093,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
|
||||
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
|
||||
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
|
||||
void (*reserved220)(void);
|
||||
TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
|
||||
int (*tcl_ServiceAll) (void); /* 221 */
|
||||
int (*tcl_ServiceEvent) (int flags); /* 222 */
|
||||
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
|
||||
@@ -2062,7 +2119,7 @@ typedef struct TclStubs {
|
||||
void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
|
||||
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
|
||||
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
|
||||
void (*reserved246)(void);
|
||||
TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
|
||||
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
|
||||
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
|
||||
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
|
||||
@@ -2083,18 +2140,18 @@ typedef struct TclStubs {
|
||||
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
|
||||
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
|
||||
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
|
||||
void (*reserved267)(void);
|
||||
void (*reserved268)(void);
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
|
||||
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
|
||||
const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
|
||||
const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
|
||||
const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
|
||||
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
|
||||
const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
|
||||
void (*reserved275)(void);
|
||||
void (*reserved276)(void);
|
||||
TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
|
||||
TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
|
||||
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
|
||||
void (*reserved278)(void);
|
||||
TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
|
||||
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
|
||||
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
|
||||
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
|
||||
@@ -2157,8 +2214,8 @@ typedef struct TclStubs {
|
||||
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
|
||||
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
|
||||
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
|
||||
void (*reserved341)(void);
|
||||
void (*reserved342)(void);
|
||||
TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
|
||||
TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
|
||||
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
|
||||
void (*tcl_ServiceModeHook) (int mode); /* 344 */
|
||||
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
|
||||
@@ -2173,7 +2230,7 @@ typedef struct TclStubs {
|
||||
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
|
||||
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
|
||||
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
|
||||
void (*reserved357)(void);
|
||||
TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
|
||||
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
|
||||
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
|
||||
int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
|
||||
@@ -2237,8 +2294,8 @@ typedef struct TclStubs {
|
||||
int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
|
||||
int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */
|
||||
int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */
|
||||
void (*reserved421)(void);
|
||||
void (*reserved422)(void);
|
||||
Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */
|
||||
Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */
|
||||
void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
|
||||
void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
|
||||
ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
|
||||
@@ -2251,8 +2308,8 @@ typedef struct TclStubs {
|
||||
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
|
||||
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
|
||||
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
|
||||
void (*reserved435)(void);
|
||||
void (*reserved436)(void);
|
||||
TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
|
||||
TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
|
||||
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
|
||||
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
|
||||
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
|
||||
@@ -2269,7 +2326,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
|
||||
int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
|
||||
int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
|
||||
const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
|
||||
const char *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
|
||||
int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
|
||||
int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
|
||||
Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
|
||||
@@ -2293,7 +2350,7 @@ typedef struct TclStubs {
|
||||
int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
|
||||
ClientData (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
|
||||
const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
|
||||
const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
|
||||
CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
|
||||
Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
|
||||
int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
|
||||
void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
|
||||
@@ -2518,14 +2575,16 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
|
||||
#define Tcl_DbIsShared \
|
||||
(tclStubsPtr->tcl_DbIsShared) /* 21 */
|
||||
/* Slot 22 is reserved */
|
||||
#define Tcl_DbNewBooleanObj \
|
||||
(tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
|
||||
#define Tcl_DbNewByteArrayObj \
|
||||
(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
|
||||
#define Tcl_DbNewDoubleObj \
|
||||
(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
|
||||
#define Tcl_DbNewListObj \
|
||||
(tclStubsPtr->tcl_DbNewListObj) /* 25 */
|
||||
/* Slot 26 is reserved */
|
||||
#define Tcl_DbNewLongObj \
|
||||
(tclStubsPtr->tcl_DbNewLongObj) /* 26 */
|
||||
#define Tcl_DbNewObj \
|
||||
(tclStubsPtr->tcl_DbNewObj) /* 27 */
|
||||
#define Tcl_DbNewStringObj \
|
||||
@@ -2570,30 +2629,36 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_ListObjLength) /* 47 */
|
||||
#define Tcl_ListObjReplace \
|
||||
(tclStubsPtr->tcl_ListObjReplace) /* 48 */
|
||||
/* Slot 49 is reserved */
|
||||
#define Tcl_NewBooleanObj \
|
||||
(tclStubsPtr->tcl_NewBooleanObj) /* 49 */
|
||||
#define Tcl_NewByteArrayObj \
|
||||
(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
|
||||
#define Tcl_NewDoubleObj \
|
||||
(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
|
||||
/* Slot 52 is reserved */
|
||||
#define Tcl_NewIntObj \
|
||||
(tclStubsPtr->tcl_NewIntObj) /* 52 */
|
||||
#define Tcl_NewListObj \
|
||||
(tclStubsPtr->tcl_NewListObj) /* 53 */
|
||||
/* Slot 54 is reserved */
|
||||
#define Tcl_NewLongObj \
|
||||
(tclStubsPtr->tcl_NewLongObj) /* 54 */
|
||||
#define Tcl_NewObj \
|
||||
(tclStubsPtr->tcl_NewObj) /* 55 */
|
||||
#define Tcl_NewStringObj \
|
||||
(tclStubsPtr->tcl_NewStringObj) /* 56 */
|
||||
/* Slot 57 is reserved */
|
||||
#define Tcl_SetBooleanObj \
|
||||
(tclStubsPtr->tcl_SetBooleanObj) /* 57 */
|
||||
#define Tcl_SetByteArrayLength \
|
||||
(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
|
||||
#define Tcl_SetByteArrayObj \
|
||||
(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
|
||||
#define Tcl_SetDoubleObj \
|
||||
(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
|
||||
/* Slot 61 is reserved */
|
||||
#define Tcl_SetIntObj \
|
||||
(tclStubsPtr->tcl_SetIntObj) /* 61 */
|
||||
#define Tcl_SetListObj \
|
||||
(tclStubsPtr->tcl_SetListObj) /* 62 */
|
||||
/* Slot 63 is reserved */
|
||||
#define Tcl_SetLongObj \
|
||||
(tclStubsPtr->tcl_SetLongObj) /* 63 */
|
||||
#define Tcl_SetObjLength \
|
||||
(tclStubsPtr->tcl_SetObjLength) /* 64 */
|
||||
#define Tcl_SetStringObj \
|
||||
@@ -2620,7 +2685,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_AsyncReady) /* 75 */
|
||||
#define Tcl_BackgroundError \
|
||||
(tclStubsPtr->tcl_BackgroundError) /* 76 */
|
||||
/* Slot 77 is reserved */
|
||||
#define Tcl_Backslash \
|
||||
(tclStubsPtr->tcl_Backslash) /* 77 */
|
||||
#define Tcl_BadChannelOption \
|
||||
(tclStubsPtr->tcl_BadChannelOption) /* 78 */
|
||||
#define Tcl_CallWhenDeleted \
|
||||
@@ -2655,7 +2721,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
|
||||
#define Tcl_CreateInterp \
|
||||
(tclStubsPtr->tcl_CreateInterp) /* 94 */
|
||||
/* Slot 95 is reserved */
|
||||
#define Tcl_CreateMathFunc \
|
||||
(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
|
||||
#define Tcl_CreateObjCommand \
|
||||
(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
|
||||
#define Tcl_CreateSlave \
|
||||
@@ -2726,7 +2793,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_Eval) /* 129 */
|
||||
#define Tcl_EvalFile \
|
||||
(tclStubsPtr->tcl_EvalFile) /* 130 */
|
||||
/* Slot 131 is reserved */
|
||||
#define Tcl_EvalObj \
|
||||
(tclStubsPtr->tcl_EvalObj) /* 131 */
|
||||
#define Tcl_EventuallyFree \
|
||||
(tclStubsPtr->tcl_EventuallyFree) /* 132 */
|
||||
#define Tcl_Exit \
|
||||
@@ -2825,7 +2893,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_GetVar2) /* 176 */
|
||||
#define Tcl_GlobalEval \
|
||||
(tclStubsPtr->tcl_GlobalEval) /* 177 */
|
||||
/* Slot 178 is reserved */
|
||||
#define Tcl_GlobalEvalObj \
|
||||
(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
|
||||
#define Tcl_HideCommand \
|
||||
(tclStubsPtr->tcl_HideCommand) /* 179 */
|
||||
#define Tcl_Init \
|
||||
@@ -2907,7 +2976,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_ScanElement) /* 218 */
|
||||
#define Tcl_ScanCountedElement \
|
||||
(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
|
||||
/* Slot 220 is reserved */
|
||||
#define Tcl_SeekOld \
|
||||
(tclStubsPtr->tcl_SeekOld) /* 220 */
|
||||
#define Tcl_ServiceAll \
|
||||
(tclStubsPtr->tcl_ServiceAll) /* 221 */
|
||||
#define Tcl_ServiceEvent \
|
||||
@@ -2958,7 +3028,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_StaticPackage) /* 244 */
|
||||
#define Tcl_StringMatch \
|
||||
(tclStubsPtr->tcl_StringMatch) /* 245 */
|
||||
/* Slot 246 is reserved */
|
||||
#define Tcl_TellOld \
|
||||
(tclStubsPtr->tcl_TellOld) /* 246 */
|
||||
#define Tcl_TraceVar \
|
||||
(tclStubsPtr->tcl_TraceVar) /* 247 */
|
||||
#define Tcl_TraceVar2 \
|
||||
@@ -2999,8 +3070,10 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
|
||||
#define Tcl_ValidateAllMemory \
|
||||
(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
|
||||
/* Slot 267 is reserved */
|
||||
/* Slot 268 is reserved */
|
||||
#define Tcl_AppendResultVA \
|
||||
(tclStubsPtr->tcl_AppendResultVA) /* 267 */
|
||||
#define Tcl_AppendStringsToObjVA \
|
||||
(tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
|
||||
#define Tcl_HashStats \
|
||||
(tclStubsPtr->tcl_HashStats) /* 269 */
|
||||
#define Tcl_ParseVar \
|
||||
@@ -3013,11 +3086,14 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_PkgProvide) /* 273 */
|
||||
#define Tcl_PkgRequire \
|
||||
(tclStubsPtr->tcl_PkgRequire) /* 274 */
|
||||
/* Slot 275 is reserved */
|
||||
/* Slot 276 is reserved */
|
||||
#define Tcl_SetErrorCodeVA \
|
||||
(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
|
||||
#define Tcl_VarEvalVA \
|
||||
(tclStubsPtr->tcl_VarEvalVA) /* 276 */
|
||||
#define Tcl_WaitPid \
|
||||
(tclStubsPtr->tcl_WaitPid) /* 277 */
|
||||
/* Slot 278 is reserved */
|
||||
#define Tcl_PanicVA \
|
||||
(tclStubsPtr->tcl_PanicVA) /* 278 */
|
||||
#define Tcl_GetVersion \
|
||||
(tclStubsPtr->tcl_GetVersion) /* 279 */
|
||||
#define Tcl_InitMemory \
|
||||
@@ -3141,8 +3217,10 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_WriteObj) /* 339 */
|
||||
#define Tcl_GetString \
|
||||
(tclStubsPtr->tcl_GetString) /* 340 */
|
||||
/* Slot 341 is reserved */
|
||||
/* Slot 342 is reserved */
|
||||
#define Tcl_GetDefaultEncodingDir \
|
||||
(tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
|
||||
#define Tcl_SetDefaultEncodingDir \
|
||||
(tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
|
||||
#define Tcl_AlertNotifier \
|
||||
(tclStubsPtr->tcl_AlertNotifier) /* 343 */
|
||||
#define Tcl_ServiceModeHook \
|
||||
@@ -3171,7 +3249,8 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
|
||||
#define Tcl_GetRegExpFromObj \
|
||||
(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
|
||||
/* Slot 357 is reserved */
|
||||
#define Tcl_EvalTokens \
|
||||
(tclStubsPtr->tcl_EvalTokens) /* 357 */
|
||||
#define Tcl_FreeParse \
|
||||
(tclStubsPtr->tcl_FreeParse) /* 358 */
|
||||
#define Tcl_LogCommandInfo \
|
||||
@@ -3298,8 +3377,10 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
|
||||
#define Tcl_UniCharCaseMatch \
|
||||
(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
|
||||
/* Slot 421 is reserved */
|
||||
/* Slot 422 is reserved */
|
||||
#define Tcl_FindHashEntry \
|
||||
(tclStubsPtr->tcl_FindHashEntry) /* 421 */
|
||||
#define Tcl_CreateHashEntry \
|
||||
(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
|
||||
#define Tcl_InitCustomHashTable \
|
||||
(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
|
||||
#define Tcl_InitObjHashTable \
|
||||
@@ -3324,8 +3405,10 @@ extern const TclStubs *tclStubsPtr;
|
||||
(tclStubsPtr->tcl_GetChannelThread) /* 433 */
|
||||
#define Tcl_GetUnicodeFromObj \
|
||||
(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
|
||||
/* Slot 435 is reserved */
|
||||
/* Slot 436 is reserved */
|
||||
#define Tcl_GetMathFuncInfo \
|
||||
(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
|
||||
#define Tcl_ListMathFuncs \
|
||||
(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
|
||||
#define Tcl_SubstObj \
|
||||
(tclStubsPtr->tcl_SubstObj) /* 437 */
|
||||
#define Tcl_DetachChannel \
|
||||
@@ -3750,6 +3833,9 @@ extern const TclStubs *tclStubsPtr;
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
|
||||
#undef Tcl_SeekOld
|
||||
#undef Tcl_TellOld
|
||||
|
||||
#undef Tcl_PkgPresent
|
||||
#define Tcl_PkgPresent(interp, name, version, exact) \
|
||||
Tcl_PkgPresentEx(interp, name, version, exact, NULL)
|
||||
@@ -3763,12 +3849,15 @@ extern const TclStubs *tclStubsPtr;
|
||||
#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
|
||||
Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
|
||||
sizeof(char *), msg, flags, indexPtr)
|
||||
#undef Tcl_NewBooleanObj
|
||||
#define Tcl_NewBooleanObj(boolValue) \
|
||||
Tcl_NewWideIntObj((boolValue)!=0)
|
||||
Tcl_NewLongObj((boolValue)!=0)
|
||||
#undef Tcl_DbNewBooleanObj
|
||||
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
|
||||
Tcl_DbNewWideIntObj((boolValue)!=0, file, line)
|
||||
Tcl_DbNewLongObj((boolValue)!=0, file, line)
|
||||
#undef Tcl_SetBooleanObj
|
||||
#define Tcl_SetBooleanObj(objPtr, boolValue) \
|
||||
Tcl_SetWideIntObj(objPtr, (boolValue)!=0)
|
||||
Tcl_SetLongObj(objPtr, (boolValue)!=0)
|
||||
#undef Tcl_SetVar
|
||||
#define Tcl_SetVar(interp, varName, newValue, flags) \
|
||||
Tcl_SetVar2(interp, varName, NULL, newValue, flags)
|
||||
@@ -3806,20 +3895,20 @@ extern const TclStubs *tclStubsPtr;
|
||||
#undef Tcl_SaveResult
|
||||
#define Tcl_SaveResult(interp, statePtr) \
|
||||
do { \
|
||||
*(statePtr) = Tcl_GetObjResult(interp); \
|
||||
Tcl_IncrRefCount(*(statePtr)); \
|
||||
(statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
|
||||
Tcl_IncrRefCount((statePtr)->objResultPtr); \
|
||||
Tcl_SetObjResult(interp, Tcl_NewObj()); \
|
||||
} while(0)
|
||||
#undef Tcl_RestoreResult
|
||||
#define Tcl_RestoreResult(interp, statePtr) \
|
||||
do { \
|
||||
Tcl_ResetResult(interp); \
|
||||
Tcl_SetObjResult(interp, *(statePtr)); \
|
||||
Tcl_DecrRefCount(*(statePtr)); \
|
||||
Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
|
||||
Tcl_DecrRefCount((statePtr)->objResultPtr); \
|
||||
} while(0)
|
||||
#undef Tcl_DiscardResult
|
||||
#define Tcl_DiscardResult(statePtr) \
|
||||
Tcl_DecrRefCount(*(statePtr))
|
||||
Tcl_DecrRefCount((statePtr)->objResultPtr)
|
||||
#undef Tcl_SetResult
|
||||
#define Tcl_SetResult(interp, result, freeProc) \
|
||||
do { \
|
||||
@@ -3878,18 +3967,25 @@ extern const TclStubs *tclStubsPtr;
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#undef Tcl_NewLongObj
|
||||
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
|
||||
#undef Tcl_NewIntObj
|
||||
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
|
||||
#undef Tcl_DbNewLongObj
|
||||
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
|
||||
#undef Tcl_SetIntObj
|
||||
#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (int)(value))
|
||||
#undef Tcl_SetLongObj
|
||||
#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj(objPtr, (long)(value))
|
||||
|
||||
/*
|
||||
* Deprecated Tcl procedures:
|
||||
*/
|
||||
|
||||
#undef Tcl_EvalObj
|
||||
#define Tcl_EvalObj(interp, objPtr) \
|
||||
Tcl_EvalObjEx(interp, objPtr, 0)
|
||||
#undef Tcl_GlobalEvalObj
|
||||
#define Tcl_GlobalEvalObj(interp, objPtr) \
|
||||
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
|
||||
|
||||
|
||||
@@ -235,7 +235,7 @@ AllocChainEntry(
|
||||
cPtr = ckalloc(sizeof(ChainEntry));
|
||||
cPtr->entry.key.objPtr = objPtr;
|
||||
Tcl_IncrRefCount(objPtr);
|
||||
Tcl_SetHashValue(&cPtr->entry, NULL);
|
||||
cPtr->entry.clientData = NULL;
|
||||
cPtr->prevPtr = cPtr->nextPtr = NULL;
|
||||
|
||||
return &cPtr->entry;
|
||||
|
||||
@@ -267,9 +267,9 @@ DisassembleByteCodeObj(
|
||||
*/
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
"ByteCode %p, refCt %" TCL_LL_MODIFIER "d, epoch %" TCL_LL_MODIFIER "d, interp %p (epoch %" TCL_LL_MODIFIER "d)\n",
|
||||
codePtr, (Tcl_WideUInt)codePtr->refCount, (Tcl_WideUInt)codePtr->compileEpoch, iPtr,
|
||||
(Tcl_WideUInt)iPtr->compileEpoch);
|
||||
"ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n",
|
||||
codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
|
||||
iPtr->compileEpoch);
|
||||
Tcl_AppendToObj(bufferObj, " Source ", -1);
|
||||
PrintSourceToObj(bufferObj, codePtr->source,
|
||||
TclMin(codePtr->numSrcBytes, 55));
|
||||
@@ -312,8 +312,8 @@ DisassembleByteCodeObj(
|
||||
int numCompiledLocals = procPtr->numCompiledLocals;
|
||||
|
||||
Tcl_AppendPrintfToObj(bufferObj,
|
||||
" Proc %p, refCt %" TCL_LL_MODIFIER "d, args %d, compiled locals %d\n",
|
||||
procPtr, (Tcl_WideUInt)procPtr->refCount, procPtr->numArgs,
|
||||
" Proc %p, refCt %u, args %d, compiled locals %d\n",
|
||||
procPtr, procPtr->refCount, procPtr->numArgs,
|
||||
numCompiledLocals);
|
||||
if (numCompiledLocals > 0) {
|
||||
CompiledLocal *localPtr = procPtr->firstLocalPtr;
|
||||
@@ -820,7 +820,7 @@ UpdateStringOfInstName(
|
||||
size_t len, inst = (size_t)objPtr->internalRep.wideValue;
|
||||
char *s, buf[TCL_INTEGER_SPACE + 5];
|
||||
|
||||
if (inst >= LAST_INST_OPCODE) {
|
||||
if (inst > LAST_INST_OPCODE) {
|
||||
sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
|
||||
s = buf;
|
||||
} else {
|
||||
|
||||
+65
-1
@@ -675,6 +675,70 @@ TclFinalizeEncodingSubsystem(void)
|
||||
Tcl_MutexUnlock(&encodingMutex);
|
||||
}
|
||||
|
||||
/*
|
||||
*-------------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_GetDefaultEncodingDir --
|
||||
*
|
||||
* Legacy public interface to retrieve first directory in the encoding
|
||||
* searchPath.
|
||||
*
|
||||
* Results:
|
||||
* The directory pathname, as a string, or NULL for an empty encoding
|
||||
* search path.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
const char *
|
||||
Tcl_GetDefaultEncodingDir(void)
|
||||
{
|
||||
int numDirs;
|
||||
Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();
|
||||
|
||||
Tcl_ListObjLength(NULL, searchPath, &numDirs);
|
||||
if (numDirs == 0) {
|
||||
return NULL;
|
||||
}
|
||||
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
|
||||
|
||||
return TclGetString(first);
|
||||
}
|
||||
|
||||
/*
|
||||
*-------------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SetDefaultEncodingDir --
|
||||
*
|
||||
* Legacy public interface to set the first directory in the encoding
|
||||
* search path.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Modifies the encoding search path.
|
||||
*
|
||||
*-------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
Tcl_SetDefaultEncodingDir(
|
||||
const char *path)
|
||||
{
|
||||
Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
|
||||
Tcl_Obj *directory = Tcl_NewStringObj(path, -1);
|
||||
|
||||
searchPath = Tcl_DuplicateObj(searchPath);
|
||||
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
|
||||
Tcl_SetEncodingSearchPath(searchPath);
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*-------------------------------------------------------------------------
|
||||
*
|
||||
@@ -3564,7 +3628,7 @@ unilen(
|
||||
static void
|
||||
InitializeEncodingSearchPath(
|
||||
char **valuePtr,
|
||||
size_t *lengthPtr,
|
||||
unsigned int *lengthPtr,
|
||||
Tcl_Encoding *encodingPtr)
|
||||
{
|
||||
const char *bytes;
|
||||
|
||||
+58
-52
@@ -87,21 +87,20 @@ static const Tcl_ObjType ensembleCmdType = {
|
||||
};
|
||||
|
||||
/*
|
||||
* The internal rep for caching ensemble subcommand lookups and
|
||||
* spell corrections.
|
||||
* The internal rep for caching ensemble subcommand lookups and spelling
|
||||
* corrections.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
size_t epoch; /* Used to confirm when the data in this
|
||||
unsigned int epoch; /* Used to confirm when the data in this
|
||||
* really structure matches up with the
|
||||
* ensemble. */
|
||||
Command *token; /* Reference to the command for which this
|
||||
* structure is a cache of the resolution. */
|
||||
Tcl_Obj *fix; /* Corrected spelling, if needed. */
|
||||
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
|
||||
* hash table. */
|
||||
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash
|
||||
* table. */
|
||||
} EnsembleCmdRep;
|
||||
|
||||
|
||||
static inline Tcl_Obj *
|
||||
NewNsObj(
|
||||
@@ -111,9 +110,8 @@ NewNsObj(
|
||||
|
||||
if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
|
||||
return Tcl_NewStringObj("::", 2);
|
||||
} else {
|
||||
return Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
}
|
||||
return Tcl_NewStringObj(nsPtr->fullName, -1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -147,7 +145,7 @@ TclNamespaceEnsembleCmd(
|
||||
{
|
||||
Tcl_Namespace *namespacePtr;
|
||||
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
|
||||
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
|
||||
*foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
|
||||
Tcl_Command token;
|
||||
Tcl_DictSearch search;
|
||||
Tcl_Obj *listObj;
|
||||
@@ -302,7 +300,8 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
|
||||
newList);
|
||||
}
|
||||
Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
|
||||
Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
|
||||
&done);
|
||||
} while (!done);
|
||||
|
||||
if (allocatedMapFlag) {
|
||||
@@ -336,8 +335,8 @@ TclNamespaceEnsembleCmd(
|
||||
}
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, cxtPtr,
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
|
||||
&simpleName);
|
||||
TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
|
||||
&actualCxtPtr, &simpleName);
|
||||
|
||||
/*
|
||||
* Create the ensemble. Note that this might delete another ensemble
|
||||
@@ -347,8 +346,8 @@ TclNamespaceEnsembleCmd(
|
||||
*/
|
||||
|
||||
token = TclCreateEnsembleInNs(interp, simpleName,
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
|
||||
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
|
||||
(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
|
||||
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
|
||||
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
|
||||
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
|
||||
@@ -576,7 +575,8 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_AppendStringsToObj(newCmd, "::", NULL);
|
||||
}
|
||||
Tcl_AppendObjToObj(newCmd, listv[0]);
|
||||
Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
|
||||
Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
|
||||
&newCmd);
|
||||
if (patchedDict == NULL) {
|
||||
patchedDict = Tcl_DuplicateObj(objv[1]);
|
||||
}
|
||||
@@ -650,15 +650,13 @@ TclNamespaceEnsembleCmd(
|
||||
Tcl_Command
|
||||
TclCreateEnsembleInNs(
|
||||
Tcl_Interp *interp,
|
||||
|
||||
const char *name, /* Simple name of command to create (no */
|
||||
/* namespace components). */
|
||||
Tcl_Namespace /* Name of namespace to create the command in. */
|
||||
*nameNsPtr,
|
||||
Tcl_Namespace
|
||||
*ensembleNsPtr, /* Name of the namespace for the ensemble. */
|
||||
int flags
|
||||
)
|
||||
const char *name, /* Simple name of command to create (no
|
||||
* namespace components). */
|
||||
Tcl_Namespace *nameNsPtr, /* Name of namespace to create the command
|
||||
* in. */
|
||||
Tcl_Namespace *ensembleNsPtr,
|
||||
/* Name of the namespace for the ensemble. */
|
||||
int flags)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
|
||||
EnsembleConfig *ensemblePtr;
|
||||
@@ -666,8 +664,8 @@ TclCreateEnsembleInNs(
|
||||
|
||||
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
|
||||
token = TclNRCreateCommandInNs(interp, name,
|
||||
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
|
||||
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
|
||||
(Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
|
||||
NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
|
||||
if (token == NULL) {
|
||||
ckfree(ensemblePtr);
|
||||
return NULL;
|
||||
@@ -701,18 +699,15 @@ TclCreateEnsembleInNs(
|
||||
}
|
||||
|
||||
return ensemblePtr->token;
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_CreateEnsemble
|
||||
*
|
||||
* Create a simple ensemble attached to the given namespace.
|
||||
*
|
||||
* Deprecated by TclCreateEnsembleInNs.
|
||||
* Create a simple ensemble attached to the given namespace. Deprecated
|
||||
* (internally) by TclCreateEnsembleInNs.
|
||||
*
|
||||
* Value
|
||||
*
|
||||
@@ -732,8 +727,8 @@ Tcl_CreateEnsemble(
|
||||
Tcl_Namespace *namespacePtr,
|
||||
int flags)
|
||||
{
|
||||
Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
|
||||
*actualNsPtr;
|
||||
Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
|
||||
*actualNsPtr;
|
||||
const char * simpleName;
|
||||
|
||||
if (nsPtr == NULL) {
|
||||
@@ -741,11 +736,10 @@ Tcl_CreateEnsemble(
|
||||
}
|
||||
|
||||
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
|
||||
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
|
||||
&foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
|
||||
return TclCreateEnsembleInNs(interp, simpleName,
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
|
||||
(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -2117,22 +2111,27 @@ TclSpellFix(
|
||||
iPtr->ensembleRewrite.numInsertedObjs = 0;
|
||||
}
|
||||
|
||||
/* Compute the valid length of the ensemble root */
|
||||
/*
|
||||
* Compute the valid length of the ensemble root.
|
||||
*/
|
||||
|
||||
size = iPtr->ensembleRewrite.numRemovedObjs + objc
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
- iPtr->ensembleRewrite.numInsertedObjs;
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
/* Awful casting abuse here */
|
||||
/*
|
||||
* Awful casting abuse here...
|
||||
*/
|
||||
search = (Tcl_Obj *const *) search[1];
|
||||
}
|
||||
|
||||
if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
|
||||
/*
|
||||
* Misspelled value was inserted. We cannot directly jump
|
||||
* to the bad value, but have to search.
|
||||
* Misspelled value was inserted. We cannot directly jump to the bad
|
||||
* value, but have to search.
|
||||
*/
|
||||
|
||||
idx = 1;
|
||||
while (idx < size) {
|
||||
if (search[idx] == bad) {
|
||||
@@ -2156,13 +2155,14 @@ TclSpellFix(
|
||||
|
||||
search = iPtr->ensembleRewrite.sourceObjs;
|
||||
if (search[0] == NULL) {
|
||||
store = (Tcl_Obj **)search[2];
|
||||
} else {
|
||||
store = (Tcl_Obj **) search[2];
|
||||
} else {
|
||||
Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
|
||||
|
||||
tmp[0] = NULL;
|
||||
tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
|
||||
tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
|
||||
tmp[2] = (Tcl_Obj *) ckalloc(size * sizeof(Tcl_Obj *));
|
||||
memcpy(tmp[2], tmp[1], size * sizeof(Tcl_Obj *));
|
||||
|
||||
iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
|
||||
TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
|
||||
@@ -2589,7 +2589,9 @@ BuildEnsembleConfig(
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/* Usual case where we can freely act on the list and dict. */
|
||||
/*
|
||||
* Usual case where we can freely act on the list and dict.
|
||||
*/
|
||||
|
||||
for (i = 0; i < subc; i++) {
|
||||
name = TclGetString(subv[i]);
|
||||
@@ -2598,7 +2600,10 @@ BuildEnsembleConfig(
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Lookup target in the dictionary */
|
||||
/*
|
||||
* Lookup target in the dictionary.
|
||||
*/
|
||||
|
||||
if (mapDict) {
|
||||
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
|
||||
if (target) {
|
||||
@@ -2610,10 +2615,11 @@ BuildEnsembleConfig(
|
||||
|
||||
/*
|
||||
* target was not in the dictionary so map onto the namespace.
|
||||
* Note in this case that we do not guarantee that the
|
||||
* command is actually there; that is the programmer's
|
||||
* responsibility (or [::unknown] of course).
|
||||
* Note in this case that we do not guarantee that the command
|
||||
* is actually there; that is the programmer's responsibility
|
||||
* (or [::unknown] of course).
|
||||
*/
|
||||
|
||||
cmdObj = Tcl_NewStringObj(name, -1);
|
||||
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
|
||||
Tcl_SetHashValue(hPtr, cmdPrefixObj);
|
||||
|
||||
+5
-5
@@ -100,7 +100,7 @@ typedef struct ThreadSpecificData {
|
||||
} ThreadSpecificData;
|
||||
static Tcl_ThreadDataKey dataKey;
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
typedef struct {
|
||||
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
|
||||
ClientData clientData; /* The one argument to Main() */
|
||||
@@ -1043,7 +1043,7 @@ TclInitSubsystems(void)
|
||||
#if USE_TCLALLOC
|
||||
TclInitAlloc(); /* Process wide mutex init */
|
||||
#endif
|
||||
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
TclInitThreadAlloc(); /* Setup thread allocator caches */
|
||||
#endif
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
@@ -1220,7 +1220,7 @@ Tcl_Finalize(void)
|
||||
* Close down the thread-specific object allocator.
|
||||
*/
|
||||
|
||||
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
TclFinalizeThreadAlloc();
|
||||
#endif
|
||||
|
||||
@@ -1538,7 +1538,7 @@ Tcl_UpdateObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1601,7 +1601,7 @@ Tcl_CreateThread(
|
||||
int flags) /* Flags controlling behaviour of the new
|
||||
* thread. */
|
||||
{
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
|
||||
int result;
|
||||
|
||||
|
||||
+396
-127
@@ -73,11 +73,11 @@ int tclTraceExec = 0;
|
||||
* expression opcodes (e.g., INST_LOR) in tclCompile.h.
|
||||
*
|
||||
* Does not include the string for INST_EXPON (and beyond), as that is
|
||||
* disjoint for backward-compatibility reasons.
|
||||
* disjoint for backward-compatability reasons.
|
||||
*/
|
||||
|
||||
static const char *const operatorStrings[] = {
|
||||
"|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
|
||||
"||", "&&", "|", "^", "&", "==", "!=", "<", ">", "<=", ">=", "<<", ">>",
|
||||
"+", "-", "*", "/", "%", "+", "-", "~", "!"
|
||||
};
|
||||
|
||||
@@ -101,6 +101,64 @@ long tclObjsAlloced = 0;
|
||||
long tclObjsFreed = 0;
|
||||
long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
|
||||
#endif /* TCL_COMPILE_STATS */
|
||||
|
||||
/*
|
||||
* Support pre-8.5 bytecodes unless specifically requested otherwise.
|
||||
*/
|
||||
|
||||
#ifndef TCL_SUPPORT_84_BYTECODE
|
||||
#define TCL_SUPPORT_84_BYTECODE 1
|
||||
#endif
|
||||
|
||||
#if TCL_SUPPORT_84_BYTECODE
|
||||
/*
|
||||
* We need to know the tclBuiltinFuncTable to support translation of pre-8.5
|
||||
* math functions to the namespace-based ::tcl::mathfunc::op in 8.5+.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
const char *name; /* Name of function. */
|
||||
int numArgs; /* Number of arguments for function. */
|
||||
} BuiltinFunc;
|
||||
|
||||
/*
|
||||
* Table describing the built-in math functions. Entries in this table are
|
||||
* indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's
|
||||
* operand byte.
|
||||
*/
|
||||
|
||||
static BuiltinFunc const tclBuiltinFuncTable[] = {
|
||||
{"acos", 1},
|
||||
{"asin", 1},
|
||||
{"atan", 1},
|
||||
{"atan2", 2},
|
||||
{"ceil", 1},
|
||||
{"cos", 1},
|
||||
{"cosh", 1},
|
||||
{"exp", 1},
|
||||
{"floor", 1},
|
||||
{"fmod", 2},
|
||||
{"hypot", 2},
|
||||
{"log", 1},
|
||||
{"log10", 1},
|
||||
{"pow", 2},
|
||||
{"sin", 1},
|
||||
{"sinh", 1},
|
||||
{"sqrt", 1},
|
||||
{"tan", 1},
|
||||
{"tanh", 1},
|
||||
{"abs", 1},
|
||||
{"double", 1},
|
||||
{"int", 1},
|
||||
{"rand", 0},
|
||||
{"round", 1},
|
||||
{"srand", 1},
|
||||
{"wide", 1},
|
||||
{NULL, 0},
|
||||
};
|
||||
|
||||
#define LAST_BUILTIN_FUNC 25
|
||||
#endif
|
||||
|
||||
/*
|
||||
* NR_TEBC
|
||||
@@ -108,7 +166,7 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
|
||||
* Minimal data required to fully reconstruct the execution state.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct TEBCdata {
|
||||
ByteCode *codePtr; /* Constant until the BC returns */
|
||||
/* -----------------------------------------*/
|
||||
ptrdiff_t *catchTop; /* These fields are used on return TO this */
|
||||
@@ -2739,6 +2797,91 @@ TEBCresume(
|
||||
return TclNREvalObjv(interp, objc, objv,
|
||||
TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
|
||||
|
||||
#if TCL_SUPPORT_84_BYTECODE
|
||||
case INST_CALL_BUILTIN_FUNC1:
|
||||
/*
|
||||
* Call one of the built-in pre-8.5 Tcl math functions. This
|
||||
* translates to INST_INVOKE_STK1 with the first argument of
|
||||
* ::tcl::mathfunc::$objv[0]. We need to insert the named math
|
||||
* function into the stack.
|
||||
*/
|
||||
|
||||
opnd = TclGetUInt1AtPtr(pc+1);
|
||||
if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) {
|
||||
TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd));
|
||||
Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd);
|
||||
}
|
||||
|
||||
TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::");
|
||||
Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1);
|
||||
|
||||
/*
|
||||
* Only 0, 1 or 2 args.
|
||||
*/
|
||||
|
||||
{
|
||||
int numArgs = tclBuiltinFuncTable[opnd].numArgs;
|
||||
Tcl_Obj *tmpPtr1, *tmpPtr2;
|
||||
|
||||
if (numArgs == 0) {
|
||||
PUSH_OBJECT(objPtr);
|
||||
} else if (numArgs == 1) {
|
||||
tmpPtr1 = POP_OBJECT();
|
||||
PUSH_OBJECT(objPtr);
|
||||
PUSH_OBJECT(tmpPtr1);
|
||||
Tcl_DecrRefCount(tmpPtr1);
|
||||
} else {
|
||||
tmpPtr2 = POP_OBJECT();
|
||||
tmpPtr1 = POP_OBJECT();
|
||||
PUSH_OBJECT(objPtr);
|
||||
PUSH_OBJECT(tmpPtr1);
|
||||
PUSH_OBJECT(tmpPtr2);
|
||||
Tcl_DecrRefCount(tmpPtr1);
|
||||
Tcl_DecrRefCount(tmpPtr2);
|
||||
}
|
||||
objc = numArgs + 1;
|
||||
}
|
||||
pcAdjustment = 2;
|
||||
goto doInvocation;
|
||||
|
||||
case INST_CALL_FUNC1:
|
||||
/*
|
||||
* Call a non-builtin Tcl math function previously registered by a
|
||||
* call to Tcl_CreateMathFunc pre-8.5. This is essentially
|
||||
* INST_INVOKE_STK1 converting the first arg to
|
||||
* ::tcl::mathfunc::$objv[0].
|
||||
*/
|
||||
|
||||
objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function
|
||||
* name is the 0-th argument. */
|
||||
|
||||
objPtr = OBJ_AT_DEPTH(objc-1);
|
||||
TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::");
|
||||
Tcl_AppendObjToObj(tmpPtr, objPtr);
|
||||
Tcl_DecrRefCount(objPtr);
|
||||
|
||||
/*
|
||||
* Variation of PUSH_OBJECT.
|
||||
*/
|
||||
|
||||
OBJ_AT_DEPTH(objc-1) = tmpPtr;
|
||||
Tcl_IncrRefCount(tmpPtr);
|
||||
|
||||
pcAdjustment = 2;
|
||||
goto doInvocation;
|
||||
#else
|
||||
/*
|
||||
* INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the
|
||||
* changes to add a ::tcl::mathfunc namespace in 8.5. Optional support
|
||||
* remains for existing bytecode precompiled files.
|
||||
*/
|
||||
|
||||
case INST_CALL_BUILTIN_FUNC1:
|
||||
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found");
|
||||
case INST_CALL_FUNC1:
|
||||
Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found");
|
||||
#endif
|
||||
|
||||
case INST_INVOKE_REPLACE:
|
||||
objc = TclGetUInt4AtPtr(pc+1);
|
||||
opnd = TclGetUInt1AtPtr(pc+5);
|
||||
@@ -3821,6 +3964,29 @@ TEBCresume(
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_ERROR(interp);
|
||||
goto gotError;
|
||||
|
||||
/*
|
||||
* This is really an unset operation these days. Do not issue.
|
||||
*/
|
||||
|
||||
case INST_DICT_DONE:
|
||||
opnd = TclGetUInt4AtPtr(pc+1);
|
||||
TRACE(("%u => OK\n", opnd));
|
||||
varPtr = LOCAL(opnd);
|
||||
while (TclIsVarLink(varPtr)) {
|
||||
varPtr = varPtr->value.linkPtr;
|
||||
}
|
||||
if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) {
|
||||
if (!TclIsVarUndefined(varPtr)) {
|
||||
TclDecrRefCount(varPtr->value.objPtr);
|
||||
}
|
||||
varPtr->value.objPtr = NULL;
|
||||
} else {
|
||||
DECACHE_STACK_INFO();
|
||||
TclPtrUnsetVarIdx(interp, varPtr, NULL, NULL, NULL, 0, opnd);
|
||||
CACHE_STACK_INFO();
|
||||
}
|
||||
NEXT_INST_F(5, 0, 0);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -4141,6 +4307,50 @@ TEBCresume(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* These two instructions are now redundant: the complete logic of the LOR
|
||||
* and LAND is now handled by the expression compiler.
|
||||
*/
|
||||
|
||||
case INST_LOR:
|
||||
case INST_LAND: {
|
||||
/*
|
||||
* Operands must be boolean or numeric. No int->double conversions are
|
||||
* performed.
|
||||
*/
|
||||
|
||||
int i1, i2, iResult;
|
||||
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
if (TclGetBooleanFromObj(NULL, valuePtr, &i1) != TCL_OK) {
|
||||
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr),
|
||||
(valuePtr->typePtr? valuePtr->typePtr->name : "null")));
|
||||
DECACHE_STACK_INFO();
|
||||
IllegalExprOperandType(interp, pc, valuePtr);
|
||||
CACHE_STACK_INFO();
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
if (TclGetBooleanFromObj(NULL, value2Ptr, &i2) != TCL_OK) {
|
||||
TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(value2Ptr),
|
||||
(value2Ptr->typePtr? value2Ptr->typePtr->name : "null")));
|
||||
DECACHE_STACK_INFO();
|
||||
IllegalExprOperandType(interp, pc, value2Ptr);
|
||||
CACHE_STACK_INFO();
|
||||
goto gotError;
|
||||
}
|
||||
|
||||
if (*pc == INST_LOR) {
|
||||
iResult = (i1 || i2);
|
||||
} else {
|
||||
iResult = (i1 && i2);
|
||||
}
|
||||
objResultPtr = TCONST(iResult);
|
||||
TRACE(("%.20s %.20s => %d\n", O2S(valuePtr),O2S(value2Ptr),iResult));
|
||||
NEXT_INST_F(1, 2, 1);
|
||||
}
|
||||
|
||||
/*
|
||||
* -----------------------------------------------------------------
|
||||
* Start of general introspector instructions.
|
||||
@@ -4878,124 +5088,10 @@ TEBCresume(
|
||||
value2Ptr = OBJ_AT_TOS;
|
||||
valuePtr = OBJ_UNDER_TOS;
|
||||
|
||||
if (valuePtr == value2Ptr) {
|
||||
match = 0;
|
||||
} else {
|
||||
/*
|
||||
* We only need to check (in)equality when we have equal length
|
||||
* strings. We can use memcmp in all (n)eq cases because we
|
||||
* don't need to worry about lexical LE/BE variance.
|
||||
*/
|
||||
|
||||
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
|
||||
memCmpFn_t memCmpFn;
|
||||
{
|
||||
int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ)
|
||||
|| (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ));
|
||||
|
||||
if (TclIsPureByteArray(valuePtr)
|
||||
&& TclIsPureByteArray(value2Ptr)) {
|
||||
s1 = (char *) Tcl_GetByteArrayFromObj(valuePtr, &s1len);
|
||||
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = memcmp;
|
||||
} else if ((valuePtr->typePtr == &tclStringType)
|
||||
&& (value2Ptr->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of
|
||||
* String type. If the char length == byte length, we can do a
|
||||
* memcmp. In benchmark testing this proved the most efficient
|
||||
* check between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
s1len = Tcl_GetCharLength(valuePtr);
|
||||
s2len = Tcl_GetCharLength(value2Ptr);
|
||||
if ((s1len == valuePtr->length)
|
||||
&& (valuePtr->bytes != NULL)
|
||||
&& (s2len == value2Ptr->length)
|
||||
&& (value2Ptr->bytes != NULL)) {
|
||||
s1 = valuePtr->bytes;
|
||||
s2 = value2Ptr->bytes;
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
s1 = (char *) Tcl_GetUnicode(valuePtr);
|
||||
s2 = (char *) Tcl_GetUnicode(value2Ptr);
|
||||
if (
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
1
|
||||
#else
|
||||
checkEq
|
||||
#endif
|
||||
) {
|
||||
memCmpFn = memcmp;
|
||||
s1len *= sizeof(Tcl_UniChar);
|
||||
s2len *= sizeof(Tcl_UniChar);
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
/*
|
||||
* In order to handle the special Tcl \xC0\x80 null encoding
|
||||
* for utf-8, strcmp can't do a simple memcmp.
|
||||
*/
|
||||
|
||||
if (TclCheckEmptyString(valuePtr) > 0) {
|
||||
s1 = "";
|
||||
s1len = 0;
|
||||
switch (TclCheckEmptyString(value2Ptr)) {
|
||||
case -1:
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
break;
|
||||
case 0:
|
||||
/* Synthesize a value for comparison */
|
||||
s2 = "1";
|
||||
s2len = 1;
|
||||
break;
|
||||
case 1:
|
||||
s2 = "";
|
||||
s2len = 0;
|
||||
}
|
||||
} else if (TclCheckEmptyString(value2Ptr) > 0) {
|
||||
s2 = "";
|
||||
s2len = 0;
|
||||
switch (TclCheckEmptyString(valuePtr)) {
|
||||
case -1:
|
||||
s1 = TclGetStringFromObj(valuePtr, &s1len);
|
||||
break;
|
||||
case 0:
|
||||
/* Synthesize a value for comparison */
|
||||
s1 = "1";
|
||||
s1len = 1;
|
||||
break;
|
||||
case 1:
|
||||
s1 = "";
|
||||
s1len = 0;
|
||||
}
|
||||
} else {
|
||||
s1 = TclGetStringFromObj(valuePtr, &s1len);
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
}
|
||||
|
||||
if (checkEq) {
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if (checkEq && (s1len != s2len)) {
|
||||
match = 1;
|
||||
} else {
|
||||
/*
|
||||
* The comparison function should compare up to the minimum
|
||||
* byte length only.
|
||||
*/
|
||||
match = memCmpFn(s1, s2,
|
||||
(size_t) ((s1len < s2len) ? s1len : s2len));
|
||||
if (match == 0) {
|
||||
match = s1len - s2len;
|
||||
}
|
||||
}
|
||||
match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -6239,6 +6335,170 @@ TEBCresume(
|
||||
TRACE(("=> CONTINUE!\n"));
|
||||
goto processExceptionReturn;
|
||||
|
||||
{
|
||||
ForeachInfo *infoPtr;
|
||||
Var *iterVarPtr, *listVarPtr;
|
||||
Tcl_Obj *oldValuePtr, *listPtr, **elements;
|
||||
ForeachVarList *varListPtr;
|
||||
int numLists, listTmpIndex, listLen, numVars;
|
||||
size_t iterNum;
|
||||
int varIndex, valIndex, continueLoop, j, iterTmpIndex;
|
||||
long i;
|
||||
|
||||
case INST_FOREACH_START4: /* DEPRECATED */
|
||||
/*
|
||||
* Initialize the temporary local var that holds the count of the
|
||||
* number of iterations of the loop body to -1.
|
||||
*/
|
||||
|
||||
opnd = TclGetUInt4AtPtr(pc+1);
|
||||
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
|
||||
iterTmpIndex = infoPtr->loopCtTemp;
|
||||
iterVarPtr = LOCAL(iterTmpIndex);
|
||||
oldValuePtr = iterVarPtr->value.objPtr;
|
||||
|
||||
if (oldValuePtr == NULL) {
|
||||
TclNewIntObj(iterVarPtr->value.objPtr, -1);
|
||||
Tcl_IncrRefCount(iterVarPtr->value.objPtr);
|
||||
} else {
|
||||
TclSetIntObj(oldValuePtr, -1);
|
||||
}
|
||||
TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
|
||||
|
||||
#ifndef TCL_COMPILE_DEBUG
|
||||
/*
|
||||
* Remark that the compiler ALWAYS sets INST_FOREACH_STEP4 immediately
|
||||
* after INST_FOREACH_START4 - let us just fall through instead of
|
||||
* jumping back to the top.
|
||||
*/
|
||||
|
||||
pc += 5;
|
||||
TCL_DTRACE_INST_NEXT();
|
||||
#else
|
||||
NEXT_INST_F(5, 0, 0);
|
||||
#endif
|
||||
|
||||
case INST_FOREACH_STEP4: /* DEPRECATED */
|
||||
/*
|
||||
* "Step" a foreach loop (i.e., begin its next iteration) by assigning
|
||||
* the next value list element to each loop var.
|
||||
*/
|
||||
|
||||
opnd = TclGetUInt4AtPtr(pc+1);
|
||||
TRACE(("%u => ", opnd));
|
||||
infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
|
||||
numLists = infoPtr->numLists;
|
||||
|
||||
/*
|
||||
* Increment the temp holding the loop iteration number.
|
||||
*/
|
||||
|
||||
iterVarPtr = LOCAL(infoPtr->loopCtTemp);
|
||||
valuePtr = iterVarPtr->value.objPtr;
|
||||
iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
|
||||
TclSetIntObj(valuePtr, iterNum);
|
||||
|
||||
/*
|
||||
* Check whether all value lists are exhausted and we should stop the
|
||||
* loop.
|
||||
*/
|
||||
|
||||
continueLoop = 0;
|
||||
listTmpIndex = infoPtr->firstValueTemp;
|
||||
for (i = 0; i < numLists; i++) {
|
||||
varListPtr = infoPtr->varLists[i];
|
||||
numVars = varListPtr->numVars;
|
||||
|
||||
listVarPtr = LOCAL(listTmpIndex);
|
||||
listPtr = listVarPtr->value.objPtr;
|
||||
if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) {
|
||||
TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n",
|
||||
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
|
||||
goto gotError;
|
||||
}
|
||||
if ((size_t)listLen > iterNum * numVars) {
|
||||
continueLoop = 1;
|
||||
}
|
||||
listTmpIndex++;
|
||||
}
|
||||
|
||||
/*
|
||||
* If some var in some var list still has a remaining list element
|
||||
* iterate one more time. Assign to var the next element from its
|
||||
* value list. We already checked above that each list temp holds a
|
||||
* valid list object (by calling Tcl_ListObjLength), but cannot rely
|
||||
* on that check remaining valid: one list could have been shimmered
|
||||
* as a side effect of setting a traced variable.
|
||||
*/
|
||||
|
||||
if (continueLoop) {
|
||||
listTmpIndex = infoPtr->firstValueTemp;
|
||||
for (i = 0; i < numLists; i++) {
|
||||
varListPtr = infoPtr->varLists[i];
|
||||
numVars = varListPtr->numVars;
|
||||
|
||||
listVarPtr = LOCAL(listTmpIndex);
|
||||
listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr);
|
||||
TclListObjGetElements(interp, listPtr, &listLen, &elements);
|
||||
|
||||
valIndex = (iterNum * numVars);
|
||||
for (j = 0; j < numVars; j++) {
|
||||
if (valIndex >= listLen) {
|
||||
TclNewObj(valuePtr);
|
||||
} else {
|
||||
valuePtr = elements[valIndex];
|
||||
}
|
||||
|
||||
varIndex = varListPtr->varIndexes[j];
|
||||
varPtr = LOCAL(varIndex);
|
||||
while (TclIsVarLink(varPtr)) {
|
||||
varPtr = varPtr->value.linkPtr;
|
||||
}
|
||||
if (TclIsVarDirectWritable(varPtr)) {
|
||||
value2Ptr = varPtr->value.objPtr;
|
||||
if (valuePtr != value2Ptr) {
|
||||
if (value2Ptr != NULL) {
|
||||
TclDecrRefCount(value2Ptr);
|
||||
}
|
||||
varPtr->value.objPtr = valuePtr;
|
||||
Tcl_IncrRefCount(valuePtr);
|
||||
}
|
||||
} else {
|
||||
DECACHE_STACK_INFO();
|
||||
if (TclPtrSetVarIdx(interp, varPtr, NULL, NULL, NULL,
|
||||
valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){
|
||||
CACHE_STACK_INFO();
|
||||
TRACE_APPEND((
|
||||
"ERROR init. index temp %d: %s\n",
|
||||
varIndex, O2S(Tcl_GetObjResult(interp))));
|
||||
TclDecrRefCount(listPtr);
|
||||
goto gotError;
|
||||
}
|
||||
CACHE_STACK_INFO();
|
||||
}
|
||||
valIndex++;
|
||||
}
|
||||
TclDecrRefCount(listPtr);
|
||||
listTmpIndex++;
|
||||
}
|
||||
}
|
||||
TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
|
||||
numLists, iterNum, (continueLoop? "continue" : "exit")));
|
||||
|
||||
/*
|
||||
* Run-time peep-hole optimisation: the compiler ALWAYS follows
|
||||
* INST_FOREACH_STEP4 with an INST_JUMP_FALSE. We just skip that
|
||||
* instruction and jump direct from here.
|
||||
*/
|
||||
|
||||
pc += 5;
|
||||
if (*pc == INST_JUMP_FALSE1) {
|
||||
NEXT_INST_F((continueLoop? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
|
||||
} else {
|
||||
NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
|
||||
}
|
||||
|
||||
}
|
||||
{
|
||||
ForeachInfo *infoPtr;
|
||||
Tcl_Obj *listPtr, **elements, *tmpPtr;
|
||||
@@ -8729,9 +8989,10 @@ PrintByteCodeInfo(
|
||||
Proc *procPtr = codePtr->procPtr;
|
||||
Interp *iPtr = (Interp *) *codePtr->interpHandle;
|
||||
|
||||
fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n",
|
||||
fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
|
||||
codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
|
||||
iPtr->compileEpoch);
|
||||
|
||||
fprintf(stdout, " Source: ");
|
||||
TclPrintSource(stdout, codePtr->source, 60);
|
||||
|
||||
@@ -8757,7 +9018,7 @@ PrintByteCodeInfo(
|
||||
#endif /* TCL_COMPILE_STATS */
|
||||
if (procPtr != NULL) {
|
||||
fprintf(stdout,
|
||||
" Proc 0x%p, refCt %zd, args %d, compiled locals %d\n",
|
||||
" Proc 0x%p, refCt %d, args %d, compiled locals %d\n",
|
||||
procPtr, procPtr->refCount, procPtr->numArgs,
|
||||
procPtr->numCompiledLocals);
|
||||
}
|
||||
@@ -8809,7 +9070,7 @@ ValidatePcAndStackTop(
|
||||
pc);
|
||||
Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc");
|
||||
}
|
||||
if ((unsigned) opCode >= LAST_INST_OPCODE) {
|
||||
if ((unsigned) opCode > LAST_INST_OPCODE) {
|
||||
fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n",
|
||||
(unsigned) opCode, relativePc);
|
||||
Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode");
|
||||
@@ -8872,11 +9133,20 @@ IllegalExprOperandType(
|
||||
if (opcode == INST_EXPON) {
|
||||
operator = "**";
|
||||
} else if (opcode <= INST_LNOT) {
|
||||
operator = operatorStrings[opcode - INST_BITOR];
|
||||
operator = operatorStrings[opcode - INST_LOR];
|
||||
}
|
||||
|
||||
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
|
||||
description = "non-numeric string";
|
||||
int numBytes;
|
||||
const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
|
||||
|
||||
if (numBytes == 0) {
|
||||
description = "empty string";
|
||||
} else if (TclCheckBadOctal(NULL, bytes)) {
|
||||
description = "invalid octal number";
|
||||
} else {
|
||||
description = "non-numeric string";
|
||||
}
|
||||
} else if (type == TCL_NUMBER_NAN) {
|
||||
description = "non-numeric floating-point value";
|
||||
} else if (type == TCL_NUMBER_DOUBLE) {
|
||||
@@ -8887,8 +9157,7 @@ IllegalExprOperandType(
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"can't use %s \"%s\" as operand of \"%s\"", description,
|
||||
Tcl_GetString(opndPtr), operator));
|
||||
"can't use %s as operand of \"%s\"", description, operator));
|
||||
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
|
||||
}
|
||||
|
||||
@@ -9699,7 +9968,7 @@ EvalStatsCmd(
|
||||
*/
|
||||
|
||||
Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n");
|
||||
for (i = 0; i < LAST_INST_OPCODE; i++) {
|
||||
for (i = 0; i <= LAST_INST_OPCODE; i++) {
|
||||
Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ",
|
||||
tclInstructionTable[i].name, statsPtr->instructionCount[i]);
|
||||
if (statsPtr->instructionCount[i]) {
|
||||
|
||||
+1
-1
@@ -142,7 +142,7 @@ Tcl_GetBoolean(
|
||||
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
|
||||
}
|
||||
if (code == TCL_OK) {
|
||||
*boolPtr = obj.internalRep.wideValue != 0;
|
||||
TclGetBooleanFromObj(NULL, &obj, boolPtr);
|
||||
}
|
||||
return code;
|
||||
}
|
||||
|
||||
+43
-18
@@ -13,6 +13,13 @@
|
||||
|
||||
#include "tclInt.h"
|
||||
|
||||
/*
|
||||
* Prevent macros from clashing with function definitions.
|
||||
*/
|
||||
|
||||
#undef Tcl_FindHashEntry
|
||||
#undef Tcl_CreateHashEntry
|
||||
|
||||
/*
|
||||
* When there are this many entries per bucket, on average, rebuild the hash
|
||||
* table to make it larger.
|
||||
@@ -28,7 +35,7 @@
|
||||
*/
|
||||
|
||||
#define RANDOM_INDEX(tablePtr, i) \
|
||||
((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask)
|
||||
((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
|
||||
|
||||
/*
|
||||
* Prototypes for the array hash key methods.
|
||||
@@ -193,7 +200,7 @@ Tcl_InitCustomHashTable(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* FindHashEntry --
|
||||
* Tcl_FindHashEntry --
|
||||
*
|
||||
* Given a hash table find the entry with a matching key.
|
||||
*
|
||||
@@ -207,6 +214,14 @@ Tcl_InitCustomHashTable(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_HashEntry *
|
||||
Tcl_FindHashEntry(
|
||||
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
|
||||
const void *key) /* Key to use to find matching entry. */
|
||||
{
|
||||
return (*((tablePtr)->findProc))(tablePtr, key);
|
||||
}
|
||||
|
||||
static Tcl_HashEntry *
|
||||
FindHashEntry(
|
||||
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
|
||||
@@ -219,7 +234,7 @@ FindHashEntry(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* CreateHashEntry --
|
||||
* Tcl_CreateHashEntry --
|
||||
*
|
||||
* Given a hash table with string keys, and a string key, find the entry
|
||||
* with a matching key. If there is no matching entry, then create a new
|
||||
@@ -237,6 +252,17 @@ FindHashEntry(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
Tcl_HashEntry *
|
||||
Tcl_CreateHashEntry(
|
||||
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
|
||||
const void *key, /* Key to use to find or create matching
|
||||
* entry. */
|
||||
int *newPtr) /* Store info here telling whether a new entry
|
||||
* was created. */
|
||||
{
|
||||
return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
|
||||
}
|
||||
|
||||
static Tcl_HashEntry *
|
||||
CreateHashEntry(
|
||||
Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */
|
||||
@@ -248,7 +274,7 @@ CreateHashEntry(
|
||||
register Tcl_HashEntry *hPtr;
|
||||
const Tcl_HashKeyType *typePtr;
|
||||
unsigned int hash;
|
||||
unsigned int index;
|
||||
int index;
|
||||
|
||||
if (tablePtr->keyType == TCL_STRING_KEYS) {
|
||||
typePtr = &tclStringHashKeyType;
|
||||
@@ -282,7 +308,7 @@ CreateHashEntry(
|
||||
|
||||
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
|
||||
hPtr = hPtr->nextPtr) {
|
||||
if (hash != hPtr->hash) {
|
||||
if (hash != PTR2UINT(hPtr->hash)) {
|
||||
continue;
|
||||
}
|
||||
if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
|
||||
@@ -295,7 +321,7 @@ CreateHashEntry(
|
||||
} else {
|
||||
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
|
||||
hPtr = hPtr->nextPtr) {
|
||||
if (hash != hPtr->hash) {
|
||||
if (hash != PTR2UINT(hPtr->hash)) {
|
||||
continue;
|
||||
}
|
||||
if (key == hPtr->key.oneWordValue) {
|
||||
@@ -325,7 +351,7 @@ CreateHashEntry(
|
||||
}
|
||||
|
||||
hPtr->tablePtr = tablePtr;
|
||||
hPtr->hash = hash;
|
||||
hPtr->hash = UINT2PTR(hash);
|
||||
hPtr->nextPtr = tablePtr->buckets[index];
|
||||
tablePtr->buckets[index] = hPtr;
|
||||
tablePtr->numEntries++;
|
||||
@@ -367,7 +393,7 @@ Tcl_DeleteHashEntry(
|
||||
const Tcl_HashKeyType *typePtr;
|
||||
Tcl_HashTable *tablePtr;
|
||||
Tcl_HashEntry **bucketPtr;
|
||||
unsigned int index;
|
||||
int index;
|
||||
|
||||
tablePtr = entryPtr->tablePtr;
|
||||
|
||||
@@ -384,9 +410,9 @@ Tcl_DeleteHashEntry(
|
||||
|
||||
if (typePtr->hashKeyProc == NULL
|
||||
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
|
||||
index = RANDOM_INDEX(tablePtr, entryPtr->hash);
|
||||
index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
|
||||
} else {
|
||||
index = entryPtr->hash & tablePtr->mask;
|
||||
index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
|
||||
}
|
||||
|
||||
bucketPtr = &tablePtr->buckets[index];
|
||||
@@ -741,14 +767,14 @@ HashArrayKey(
|
||||
void *keyPtr) /* Key from which to compute hash value. */
|
||||
{
|
||||
register const int *array = (const int *) keyPtr;
|
||||
register TCL_HASH_TYPE result;
|
||||
register unsigned int result;
|
||||
int count;
|
||||
|
||||
for (result = 0, count = tablePtr->keyType; count > 0;
|
||||
count--, array++) {
|
||||
result += *array;
|
||||
}
|
||||
return result;
|
||||
return (TCL_HASH_TYPE) result;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -837,7 +863,7 @@ HashStringKey(
|
||||
void *keyPtr) /* Key from which to compute hash value. */
|
||||
{
|
||||
register const char *string = keyPtr;
|
||||
register TCL_HASH_TYPE result;
|
||||
register unsigned int result;
|
||||
register char c;
|
||||
|
||||
/*
|
||||
@@ -877,7 +903,7 @@ HashStringKey(
|
||||
result += (result << 3) + UCHAR(c);
|
||||
}
|
||||
}
|
||||
return result;
|
||||
return (TCL_HASH_TYPE) result;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -959,8 +985,7 @@ static void
|
||||
RebuildTable(
|
||||
register Tcl_HashTable *tablePtr) /* Table to enlarge. */
|
||||
{
|
||||
int count, oldSize = tablePtr->numBuckets;
|
||||
unsigned int index;
|
||||
int count, index, oldSize = tablePtr->numBuckets;
|
||||
Tcl_HashEntry **oldBuckets = tablePtr->buckets;
|
||||
register Tcl_HashEntry **oldChainPtr, **newChainPtr;
|
||||
register Tcl_HashEntry *hPtr;
|
||||
@@ -1013,9 +1038,9 @@ RebuildTable(
|
||||
*oldChainPtr = hPtr->nextPtr;
|
||||
if (typePtr->hashKeyProc == NULL
|
||||
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
|
||||
index = RANDOM_INDEX(tablePtr, hPtr->hash);
|
||||
index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
|
||||
} else {
|
||||
index = hPtr->hash & tablePtr->mask;
|
||||
index = PTR2UINT(hPtr->hash) & tablePtr->mask;
|
||||
}
|
||||
hPtr->nextPtr = tablePtr->buckets[index];
|
||||
tablePtr->buckets[index] = hPtr;
|
||||
|
||||
@@ -73,6 +73,13 @@ Tcl_RecordAndEval(
|
||||
Tcl_IncrRefCount(cmdPtr);
|
||||
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
|
||||
|
||||
/*
|
||||
* Move the interpreter's object result to the string result, then
|
||||
* reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
/*
|
||||
* Discard the Tcl object created to hold the command.
|
||||
*/
|
||||
|
||||
@@ -9036,6 +9036,20 @@ ZeroTransferTimerProc(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED)
|
||||
int
|
||||
TclCopyChannelOld(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
Tcl_Channel inChan, /* Channel to read from. */
|
||||
Tcl_Channel outChan, /* Channel to write to. */
|
||||
int toRead, /* Amount of data to copy, or -1 for all. */
|
||||
Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */
|
||||
{
|
||||
return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
|
||||
cmdPtr);
|
||||
}
|
||||
#endif
|
||||
|
||||
int
|
||||
TclCopyChannel(
|
||||
Tcl_Interp *interp, /* Current interpreter. */
|
||||
|
||||
+28
-1
@@ -15,7 +15,7 @@
|
||||
* Callback structure for accept callback in a TCP server.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct AcceptCallback {
|
||||
Tcl_Obj *script; /* Script to invoke. */
|
||||
Tcl_Interp *interp; /* Interpreter in which to run it. */
|
||||
} AcceptCallback;
|
||||
@@ -137,6 +137,19 @@ Tcl_PutsObjCmd(
|
||||
chanObjPtr = objv[2];
|
||||
string = objv[3];
|
||||
break;
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
|
||||
/*
|
||||
* The code below provides backwards compatibility with an old
|
||||
* form of the command that is no longer recommended or
|
||||
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
|
||||
* maybe even earlier.
|
||||
*/
|
||||
|
||||
chanObjPtr = objv[1];
|
||||
string = objv[2];
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
/* Fall through */
|
||||
default: /* [puts] or
|
||||
@@ -426,11 +439,25 @@ Tcl_ReadObjCmd(
|
||||
if (i < objc) {
|
||||
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|
||||
|| (toRead < 0)) {
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
/*
|
||||
* The code below provides backwards compatibility with an old
|
||||
* form of the command that is no longer recommended or
|
||||
* documented. See also [Bug #3151675]. Will be removed in Tcl 9,
|
||||
* maybe even earlier.
|
||||
*/
|
||||
|
||||
if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
|
||||
#endif
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"expected non-negative integer but got \"%s\"",
|
||||
TclGetString(objv[i])));
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
|
||||
return TCL_ERROR;
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
}
|
||||
newline = 1;
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
+24
-24
@@ -39,7 +39,7 @@ static int ReflectOutput(ClientData clientData, const char *buf,
|
||||
int toWrite, int *errorCodePtr);
|
||||
static void ReflectWatch(ClientData clientData, int mask);
|
||||
static int ReflectBlock(ClientData clientData, int mode);
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
static void ReflectThread(ClientData clientData, int action);
|
||||
static int ReflectEventRun(Tcl_Event *ev, int flags);
|
||||
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
|
||||
@@ -76,7 +76,7 @@ static const Tcl_ChannelType tclRChannelType = {
|
||||
NULL, /* Flush channel. Not used by core. NULL'able */
|
||||
NULL, /* Handle events. NULL'able */
|
||||
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
ReflectThread, /* thread action, tracking owner */
|
||||
#else
|
||||
NULL, /* thread action */
|
||||
@@ -97,7 +97,7 @@ typedef struct {
|
||||
* interpreter/thread containing its Tcl
|
||||
* command is gone.
|
||||
*/
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
|
||||
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
|
||||
#endif
|
||||
@@ -201,7 +201,7 @@ typedef enum {
|
||||
#define NEGIMPL(a,b)
|
||||
#define HAS(x,f) (x & FLAG(f))
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Thread specific types and structures.
|
||||
*
|
||||
@@ -451,7 +451,7 @@ static const char *msg_read_toomuch = "{read delivered more than requested}";
|
||||
static const char *msg_write_toomuch = "{write wrote more than requested}";
|
||||
static const char *msg_write_nothing = "{write wrote nothing}";
|
||||
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
static const char *msg_send_originlost = "{Channel thread lost}";
|
||||
#endif /* TCL_THREADS */
|
||||
static const char *msg_send_dstlost = "{Owner lost}";
|
||||
@@ -706,7 +706,7 @@ TclChanCreateObjCmd(
|
||||
Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
|
||||
}
|
||||
Tcl_SetHashValue(hPtr, chan);
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
rcmPtr = GetThreadReflectedChannelMap();
|
||||
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
|
||||
&isNew);
|
||||
@@ -750,7 +750,7 @@ TclChanCreateObjCmd(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
typedef struct {
|
||||
Tcl_Event header;
|
||||
ReflectedChannel *rcPtr;
|
||||
@@ -917,11 +917,11 @@ TclChanPostEventObjCmd(
|
||||
* We have the channel and the events to post.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->owner == rcPtr->thread) {
|
||||
#endif
|
||||
Tcl_NotifyChannel(chan, events);
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
} else {
|
||||
ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
|
||||
|
||||
@@ -1137,7 +1137,7 @@ ReflectClose(
|
||||
* if lost?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1169,7 +1169,7 @@ ReflectClose(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1216,7 +1216,7 @@ ReflectClose(
|
||||
Tcl_DeleteHashEntry(hPtr);
|
||||
}
|
||||
}
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
rcmPtr = GetThreadReflectedChannelMap();
|
||||
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
|
||||
Tcl_GetChannelName(rcPtr->chan));
|
||||
@@ -1267,7 +1267,7 @@ ReflectInput(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1373,7 +1373,7 @@ ReflectOutput(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1502,7 +1502,7 @@ ReflectSeekWide(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1625,7 +1625,7 @@ ReflectWatch(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1683,7 +1683,7 @@ ReflectBlock(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1719,7 +1719,7 @@ ReflectBlock(
|
||||
return errorNum;
|
||||
}
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1789,7 +1789,7 @@ ReflectSetOption(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1868,7 +1868,7 @@ ReflectGetOption(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rcPtr->thread != Tcl_GetCurrentThread()) {
|
||||
int opcode;
|
||||
ForwardParam p;
|
||||
@@ -2131,7 +2131,7 @@ NewReflectedChannel(
|
||||
rcPtr->chan = NULL;
|
||||
rcPtr->interp = interp;
|
||||
rcPtr->dead = 0;
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
rcPtr->thread = Tcl_GetCurrentThread();
|
||||
#endif
|
||||
rcPtr->mode = mode;
|
||||
@@ -2506,7 +2506,7 @@ DeleteReflectedChannelMap(
|
||||
Tcl_HashEntry *hPtr; /* Search variable. */
|
||||
ReflectedChannel *rcPtr;
|
||||
Tcl_Channel chan;
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardingEvent *evPtr;
|
||||
ForwardParam *paramPtr;
|
||||
@@ -2536,7 +2536,7 @@ DeleteReflectedChannelMap(
|
||||
Tcl_DeleteHashTable(&rcmPtr->map);
|
||||
ckfree(&rcmPtr->map);
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* The origin interpreter for one or more reflected channels is gone.
|
||||
*/
|
||||
@@ -2622,7 +2622,7 @@ DeleteReflectedChannelMap(
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
|
||||
+19
-19
@@ -127,7 +127,7 @@ typedef struct {
|
||||
* in the argv, see below. The separate field
|
||||
* gives us direct access, needed when working
|
||||
* with the reflection maps. */
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
|
||||
#endif
|
||||
|
||||
@@ -220,7 +220,7 @@ typedef enum {
|
||||
#define NEGIMPL(a,b)
|
||||
#define HAS(x,f) (x & FLAG(f))
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Thread specific types and structures.
|
||||
*
|
||||
@@ -438,7 +438,7 @@ static void DeleteReflectedTransformMap(ClientData clientData,
|
||||
|
||||
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
|
||||
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
static const char *msg_send_originlost = "{Channel thread lost}";
|
||||
static const char *msg_send_dstlost = "{Owner lost}";
|
||||
#endif /* TCL_THREADS */
|
||||
@@ -699,7 +699,7 @@ TclChanPushObjCmd(
|
||||
Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
|
||||
}
|
||||
Tcl_SetHashValue(hPtr, rtPtr);
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
rtmPtr = GetThreadReflectedTransformMap();
|
||||
hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
|
||||
Tcl_SetHashValue(hPtr, rtPtr);
|
||||
@@ -911,7 +911,7 @@ ReflectClose(
|
||||
* if lost?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -938,7 +938,7 @@ ReflectClose(
|
||||
|
||||
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
|
||||
if (!TransformDrain(rtPtr, &errorCode)) {
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
Tcl_EventuallyFree(rtPtr,
|
||||
(Tcl_FreeProc *) FreeReflectedTransform);
|
||||
@@ -952,7 +952,7 @@ ReflectClose(
|
||||
|
||||
if (HAS(rtPtr->methods, METH_FLUSH)) {
|
||||
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
Tcl_EventuallyFree(rtPtr,
|
||||
(Tcl_FreeProc *) FreeReflectedTransform);
|
||||
@@ -968,7 +968,7 @@ ReflectClose(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -1025,7 +1025,7 @@ ReflectClose(
|
||||
* under a channel by deleting the owning thread.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
rtmPtr = GetThreadReflectedTransformMap();
|
||||
hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
|
||||
if (hPtr) {
|
||||
@@ -1767,7 +1767,7 @@ NewReflectedTransform(
|
||||
|
||||
rtPtr->chan = NULL;
|
||||
rtPtr->methods = 0;
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
rtPtr->thread = Tcl_GetCurrentThread();
|
||||
#endif
|
||||
rtPtr->parent = parentChan;
|
||||
@@ -2152,7 +2152,7 @@ DeleteReflectedTransformMap(
|
||||
Tcl_HashSearch hSearch; /* Search variable. */
|
||||
Tcl_HashEntry *hPtr; /* Search variable. */
|
||||
ReflectedTransform *rtPtr;
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
ForwardingResult *resultPtr;
|
||||
ForwardingEvent *evPtr;
|
||||
ForwardParam *paramPtr;
|
||||
@@ -2182,7 +2182,7 @@ DeleteReflectedTransformMap(
|
||||
Tcl_DeleteHashTable(&rtmPtr->map);
|
||||
ckfree(&rtmPtr->map);
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* The origin interpreter for one or more reflected channels is gone.
|
||||
*/
|
||||
@@ -2254,7 +2254,7 @@ DeleteReflectedTransformMap(
|
||||
#endif /* TCL_THREADS */
|
||||
}
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -3088,7 +3088,7 @@ TransformRead(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3144,7 +3144,7 @@ TransformWrite(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3210,7 +3210,7 @@ TransformDrain(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3260,7 +3260,7 @@ TransformFlush(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3315,7 +3315,7 @@ TransformClear(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
@@ -3347,7 +3347,7 @@ TransformLimit(
|
||||
* Are we in the correct thread?
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (rtPtr->thread != Tcl_GetCurrentThread()) {
|
||||
ForwardParam p;
|
||||
|
||||
|
||||
+1
-1
@@ -223,7 +223,7 @@ TclCreateSocketAddress(
|
||||
* using AI_ADDRCONFIG is probably low even in situations where it works,
|
||||
* we'll leave it out for now. After all, it is just an optimisation.
|
||||
*
|
||||
* Missing on NetBSD.
|
||||
* Missing on: OpenBSD, NetBSD.
|
||||
* Causes failure when used on AIX 5.1 and HP-UX
|
||||
*/
|
||||
|
||||
|
||||
+2
-2
@@ -3197,8 +3197,8 @@ TclSkipUnlink(
|
||||
#ifndef AUFS_SUPER_MAGIC
|
||||
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
|
||||
#endif /* AUFS_SUPER_MAGIC */
|
||||
if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
|
||||
(fs.f_type == AUFS_SUPER_MAGIC)) {
|
||||
if ((statfs(Tcl_GetString(shlibFile), &fs) == 0)
|
||||
&& (fs.f_type == AUFS_SUPER_MAGIC)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
+31
-2
@@ -881,6 +881,29 @@ Tcl_WrongNumArgs(
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
const char *elementStr;
|
||||
|
||||
/*
|
||||
* [incr Tcl] does something fairly horrific when generating error
|
||||
* messages for its ensembles; it passes the whole set of ensemble
|
||||
* arguments as a list in the first argument. This means that this code
|
||||
* causes a problem in iTcl if it attempts to correctly quote all
|
||||
* arguments, which would be the correct thing to do. We work around this
|
||||
* nasty behaviour for now, and hope that we can remove it all in the
|
||||
* future...
|
||||
*/
|
||||
|
||||
#ifndef AVOID_HACKS_FOR_ITCL
|
||||
int isFirst = 1; /* Special flag used to inhibit the treating
|
||||
* of the first word as a list element so the
|
||||
* hacky way Itcl generates error messages for
|
||||
* its ensembles will still work. [Bug
|
||||
* 1066837] */
|
||||
# define MAY_QUOTE_WORD (!isFirst)
|
||||
# define AFTER_FIRST_WORD (isFirst = 0)
|
||||
#else /* !AVOID_HACKS_FOR_ITCL */
|
||||
# define MAY_QUOTE_WORD 1
|
||||
# define AFTER_FIRST_WORD (void) 0
|
||||
#endif /* AVOID_HACKS_FOR_ITCL */
|
||||
|
||||
TclNewObj(objPtr);
|
||||
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
|
||||
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
|
||||
@@ -947,7 +970,7 @@ Tcl_WrongNumArgs(
|
||||
flags = 0;
|
||||
len = TclScanElement(elementStr, elemLen, &flags);
|
||||
|
||||
if (len != elemLen) {
|
||||
if (MAY_QUOTE_WORD && len != elemLen) {
|
||||
char *quotedElementStr = TclStackAlloc(interp,
|
||||
(unsigned)len + 1);
|
||||
|
||||
@@ -959,6 +982,8 @@ Tcl_WrongNumArgs(
|
||||
Tcl_AppendToObj(objPtr, elementStr, elemLen);
|
||||
}
|
||||
|
||||
AFTER_FIRST_WORD;
|
||||
|
||||
/*
|
||||
* Add a space if the word is not the last one (which has a
|
||||
* moderately complex condition here).
|
||||
@@ -996,7 +1021,7 @@ Tcl_WrongNumArgs(
|
||||
flags = 0;
|
||||
len = TclScanElement(elementStr, elemLen, &flags);
|
||||
|
||||
if (len != elemLen) {
|
||||
if (MAY_QUOTE_WORD && len != elemLen) {
|
||||
char *quotedElementStr = TclStackAlloc(interp,
|
||||
(unsigned) len + 1);
|
||||
|
||||
@@ -1009,6 +1034,8 @@ Tcl_WrongNumArgs(
|
||||
}
|
||||
}
|
||||
|
||||
AFTER_FIRST_WORD;
|
||||
|
||||
/*
|
||||
* Append a space character (" ") if there is more text to follow
|
||||
* (either another element from objv, or the message string).
|
||||
@@ -1031,6 +1058,8 @@ Tcl_WrongNumArgs(
|
||||
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
|
||||
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
|
||||
Tcl_SetObjResult(interp, objPtr);
|
||||
#undef MAY_QUOTE_WORD
|
||||
#undef AFTER_FIRST_WORD
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
+138
-178
@@ -50,11 +50,10 @@ declare 6 {
|
||||
declare 7 {
|
||||
int TclCopyAndCollapse(int count, const char *src, char *dst)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 8 {
|
||||
# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
|
||||
# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
|
||||
#}
|
||||
declare 8 {deprecated {}} {
|
||||
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
|
||||
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
|
||||
}
|
||||
|
||||
# TclCreatePipeline unofficially exported for use by BLT.
|
||||
|
||||
@@ -184,7 +183,7 @@ declare 41 {
|
||||
Tcl_Command TclGetOriginalCommand(Tcl_Command command)
|
||||
}
|
||||
declare 42 {
|
||||
const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
|
||||
}
|
||||
# Removed in 8.5a2:
|
||||
#declare 43 {
|
||||
@@ -314,11 +313,9 @@ declare 75 {
|
||||
declare 76 {
|
||||
unsigned long TclpGetSeconds(void)
|
||||
}
|
||||
|
||||
# Removed in 9.0:
|
||||
#declare 77 {
|
||||
# void TclpGetTime(Tcl_Time *time)
|
||||
#}
|
||||
declare 77 {deprecated {}} {
|
||||
void TclpGetTime(Tcl_Time *time)
|
||||
}
|
||||
# Removed in 8.6:
|
||||
#declare 78 {
|
||||
# int TclpGetTimeZone(unsigned long time)
|
||||
@@ -358,11 +355,10 @@ declare 81 {
|
||||
# declare 87 {
|
||||
# void TclPlatformInit(Tcl_Interp *interp)
|
||||
# }
|
||||
# Removed in 9.0:
|
||||
#declare 88 {
|
||||
# char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
|
||||
# const char *name1, const char *name2, int flags)
|
||||
#}
|
||||
declare 88 {deprecated {}} {
|
||||
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
|
||||
const char *name1, const char *name2, int flags)
|
||||
}
|
||||
declare 89 {
|
||||
int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
|
||||
Tcl_Command cmd)
|
||||
@@ -412,7 +408,7 @@ declare 98 {
|
||||
# Tcl_Obj *objPtr, int flags)
|
||||
#}
|
||||
declare 101 {
|
||||
const char *TclSetPreInitScript(const char *string)
|
||||
CONST86 char *TclSetPreInitScript(const char *string)
|
||||
}
|
||||
declare 102 {
|
||||
void TclSetupEnv(Tcl_Interp *interp)
|
||||
@@ -421,10 +417,9 @@ declare 103 {
|
||||
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
|
||||
int *portPtr)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 104 {
|
||||
# int TclSockMinimumBuffersOld(int sock, int size)
|
||||
#}
|
||||
declare 104 {deprecated {}} {
|
||||
int TclSockMinimumBuffersOld(int sock, int size)
|
||||
}
|
||||
# Replaced by Tcl_FSStat in 8.4:
|
||||
#declare 105 {
|
||||
# int TclStat(const char *path, Tcl_StatBuf *buf)
|
||||
@@ -457,35 +452,29 @@ declare 111 {
|
||||
Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
|
||||
Tcl_ResolveCompiledVarProc *compiledVarProc)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 112 {
|
||||
# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
# Tcl_Obj *objPtr)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 113 {
|
||||
# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
|
||||
# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 114 {
|
||||
# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 115 {
|
||||
# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
# const char *pattern, int resetListFirst)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 116 {
|
||||
# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
|
||||
# Tcl_Namespace *contextNsPtr, int flags)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 117 {
|
||||
# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
|
||||
# Tcl_Namespace *contextNsPtr, int flags)
|
||||
#}
|
||||
declare 112 {
|
||||
int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 113 {
|
||||
Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
|
||||
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
|
||||
}
|
||||
declare 114 {
|
||||
void TclDeleteNamespace(Tcl_Namespace *nsPtr)
|
||||
}
|
||||
declare 115 {
|
||||
int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int resetListFirst)
|
||||
}
|
||||
declare 116 {
|
||||
Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags)
|
||||
}
|
||||
declare 117 {
|
||||
Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags)
|
||||
}
|
||||
declare 118 {
|
||||
int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
|
||||
Tcl_ResolverInfo *resInfo)
|
||||
@@ -498,37 +487,31 @@ declare 120 {
|
||||
Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 121 {
|
||||
# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
# const char *pattern)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 122 {
|
||||
# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 123 {
|
||||
# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
|
||||
# Tcl_Obj *objPtr)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 124 {
|
||||
# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 125 {
|
||||
# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
|
||||
#}
|
||||
declare 121 {
|
||||
int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern)
|
||||
}
|
||||
declare 122 {
|
||||
Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 123 {
|
||||
void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
|
||||
Tcl_Obj *objPtr)
|
||||
}
|
||||
declare 124 {
|
||||
Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
|
||||
}
|
||||
declare 125 {
|
||||
Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
|
||||
}
|
||||
declare 126 {
|
||||
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
|
||||
Tcl_Obj *objPtr)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 127 {
|
||||
# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
# const char *pattern, int allowOverwrite)
|
||||
#}
|
||||
declare 127 {
|
||||
int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int allowOverwrite)
|
||||
}
|
||||
declare 128 {
|
||||
void Tcl_PopCallFrame(Tcl_Interp *interp)
|
||||
}
|
||||
@@ -547,10 +530,9 @@ declare 131 {
|
||||
declare 132 {
|
||||
int TclpHasSockets(Tcl_Interp *interp)
|
||||
}
|
||||
# Removed in 9.0
|
||||
#declare 133 {
|
||||
# struct tm *TclpGetDate(const time_t *time, int useGMT)
|
||||
#}
|
||||
declare 133 {deprecated {}} {
|
||||
struct tm *TclpGetDate(const time_t *time, int useGMT)
|
||||
}
|
||||
# Removed in 8.5
|
||||
#declare 134 {
|
||||
# size_t TclpStrftime(char *s, size_t maxsize, const char *format,
|
||||
@@ -641,14 +623,12 @@ declare 156 {
|
||||
declare 157 {
|
||||
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
|
||||
}
|
||||
# REMOVED - use public Tcl_SetStartupScript()
|
||||
#declare 158 {
|
||||
# void TclSetStartupScriptFileName(const char *filename)
|
||||
#}
|
||||
# REMOVED - use public Tcl_GetStartupScript()
|
||||
#declare 159 {
|
||||
# const char *TclGetStartupScriptFileName(void)
|
||||
#}
|
||||
declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
|
||||
void TclSetStartupScriptFileName(const char *filename)
|
||||
}
|
||||
declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
|
||||
const char *TclGetStartupScriptFileName(void)
|
||||
}
|
||||
#declare 160 {
|
||||
# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
|
||||
# Tcl_DString *dirPtr, char *pattern, char *tail,
|
||||
@@ -692,15 +672,12 @@ declare 166 {
|
||||
int index, Tcl_Obj *valuePtr)
|
||||
}
|
||||
|
||||
# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
|
||||
# REMOVED - use public Tcl_SetStartupScript()
|
||||
#declare 167 {
|
||||
# void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
|
||||
#}
|
||||
# REMOVED - use public Tcl_GetStartupScript()
|
||||
#declare 168 {
|
||||
# Tcl_Obj *TclGetStartupScriptPath(void)
|
||||
#}
|
||||
declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
|
||||
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
|
||||
}
|
||||
declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
|
||||
Tcl_Obj *TclGetStartupScriptPath(void)
|
||||
}
|
||||
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
|
||||
declare 169 {
|
||||
int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
|
||||
@@ -746,13 +723,12 @@ declare 177 {
|
||||
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
|
||||
const char *operation, const char *reason)
|
||||
}
|
||||
# TIP 338 made these public - now declared in tcl.h
|
||||
#declare 178 {
|
||||
# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
|
||||
#}
|
||||
#declare 179 {
|
||||
# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
|
||||
#}
|
||||
declare 178 {
|
||||
void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
|
||||
}
|
||||
declare 179 {
|
||||
Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
|
||||
}
|
||||
|
||||
# REMOVED
|
||||
# Allocate lists without copying arrays
|
||||
@@ -764,14 +740,12 @@ declare 177 {
|
||||
# const char *file, int line)
|
||||
#}
|
||||
|
||||
# Removed in 9.0
|
||||
#declare 182 {
|
||||
# struct tm *TclpLocaltime(const time_t *clock)
|
||||
#}
|
||||
# Removed in 9.0
|
||||
#declare 183 {
|
||||
# struct tm *TclpGmtime(const time_t *clock)
|
||||
#}
|
||||
declare 182 {deprecated {}} {
|
||||
struct tm *TclpLocaltime(const time_t *clock)
|
||||
}
|
||||
declare 183 {deprecated {}} {
|
||||
struct tm *TclpGmtime(const time_t *clock)
|
||||
}
|
||||
|
||||
# For the new "Thread Storage" subsystem.
|
||||
|
||||
@@ -953,12 +927,9 @@ declare 234 {
|
||||
declare 235 {
|
||||
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
|
||||
}
|
||||
|
||||
|
||||
# TIP 337 made this one public
|
||||
#declare 236 {
|
||||
# void TclBackgroundException(Tcl_Interp *interp, int code)
|
||||
#}
|
||||
declare 236 {deprecated {use Tcl_BackgroundException}} {
|
||||
void TclBackgroundException(Tcl_Interp *interp, int code)
|
||||
}
|
||||
|
||||
# TIP #285: Script cancellation support.
|
||||
declare 237 {
|
||||
@@ -1067,20 +1038,17 @@ interface tclIntPlat
|
||||
declare 0 win {
|
||||
void TclWinConvertError(DWORD errCode)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 1 win {
|
||||
# void TclWinConvertWSAError(DWORD errCode)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 2 win {
|
||||
# struct servent *TclWinGetServByName(const char *nm,
|
||||
# const char *proto)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 3 win {
|
||||
# int TclWinGetSockOpt(SOCKET s, int level, int optname,
|
||||
# char *optval, int *optlen)
|
||||
#}
|
||||
declare 1 win {
|
||||
void TclWinConvertWSAError(DWORD errCode)
|
||||
}
|
||||
declare 2 win {
|
||||
struct servent *TclWinGetServByName(const char *nm,
|
||||
const char *proto)
|
||||
}
|
||||
declare 3 win {
|
||||
int TclWinGetSockOpt(SOCKET s, int level, int optname,
|
||||
char *optval, int *optlen)
|
||||
}
|
||||
declare 4 win {
|
||||
HINSTANCE TclWinGetTclInstance(void)
|
||||
}
|
||||
@@ -1092,26 +1060,23 @@ declare 5 win {
|
||||
# declare 5 win {
|
||||
# HINSTANCE TclWinLoadLibrary(char *name)
|
||||
# }
|
||||
# Removed in 9.0:
|
||||
#declare 6 win {
|
||||
# unsigned short TclWinNToHS(unsigned short ns)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 7 win {
|
||||
# int TclWinSetSockOpt(SOCKET s, int level, int optname,
|
||||
# const char *optval, int optlen)
|
||||
#}
|
||||
declare 6 win {
|
||||
unsigned short TclWinNToHS(unsigned short ns)
|
||||
}
|
||||
declare 7 win {
|
||||
int TclWinSetSockOpt(SOCKET s, int level, int optname,
|
||||
const char *optval, int optlen)
|
||||
}
|
||||
declare 8 win {
|
||||
int TclpGetPid(Tcl_Pid pid)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 9 win {
|
||||
# int TclWinGetPlatformId(void)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 10 win {
|
||||
# Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
#}
|
||||
declare 9 win {
|
||||
int TclWinGetPlatformId(void)
|
||||
}
|
||||
# new for 8.4.20+/8.5.12+ Cygwin only
|
||||
declare 10 win {
|
||||
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
|
||||
}
|
||||
# Removed in 8.3.1 (for Win32s only):
|
||||
#declare 10 win {
|
||||
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
|
||||
@@ -1162,10 +1127,9 @@ declare 19 win {
|
||||
declare 20 win {
|
||||
void TclWinAddProcess(HANDLE hProcess, DWORD id)
|
||||
}
|
||||
# Removed in 9.0:
|
||||
#declare 21 win {
|
||||
# char *TclpInetNtoa(struct in_addr addr)
|
||||
#}
|
||||
declare 21 win {
|
||||
char *TclpInetNtoa(struct in_addr addr)
|
||||
}
|
||||
# removed permanently for 8.4
|
||||
#declare 21 win {
|
||||
# void TclpAsyncMark(Tcl_AsyncHandler async)
|
||||
@@ -1186,10 +1150,9 @@ declare 24 win {
|
||||
#declare 25 win {
|
||||
# TclPlatformType *TclWinGetPlatform(void)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 26 win {
|
||||
# void TclWinSetInterfaces(int wide)
|
||||
#}
|
||||
declare 26 win {
|
||||
void TclWinSetInterfaces(int wide)
|
||||
}
|
||||
|
||||
# Added in Tcl 8.3.3 / 8.4
|
||||
|
||||
@@ -1199,10 +1162,9 @@ declare 27 win {
|
||||
|
||||
# Added in 8.4.2
|
||||
|
||||
# Removed in 9.0:
|
||||
#declare 28 win {
|
||||
# void TclWinResetInterfaces(void)
|
||||
#}
|
||||
declare 28 win {
|
||||
void TclWinResetInterfaces(void)
|
||||
}
|
||||
|
||||
################################
|
||||
# Unix specific functions
|
||||
@@ -1249,22 +1211,20 @@ declare 9 unix {
|
||||
|
||||
# Added in 8.4:
|
||||
|
||||
# Removed in 9.0:
|
||||
#declare 10 unix {
|
||||
# Tcl_DirEntry *TclpReaddir(DIR *dir)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 11 unix {
|
||||
# struct tm *TclpLocaltime_unix(const time_t *clock)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 12 unix {
|
||||
# struct tm *TclpGmtime_unix(const time_t *clock)
|
||||
#}
|
||||
# Removed in 9.0:
|
||||
#declare 13 unix {
|
||||
# char *TclpInetNtoa(struct in_addr addr)
|
||||
#}
|
||||
declare 10 unix {
|
||||
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
|
||||
}
|
||||
# Slots 11 and 12 are forwarders for functions that were promoted to
|
||||
# generic Stubs
|
||||
declare 11 unix {
|
||||
struct tm *TclpLocaltime_unix(const time_t *clock)
|
||||
}
|
||||
declare 12 unix {
|
||||
struct tm *TclpGmtime_unix(const time_t *clock)
|
||||
}
|
||||
declare 13 unix {
|
||||
char *TclpInetNtoa(struct in_addr addr)
|
||||
}
|
||||
|
||||
# Added in 8.5:
|
||||
|
||||
|
||||
+164
-73
@@ -25,6 +25,19 @@
|
||||
|
||||
#undef ACCEPT_NAN
|
||||
|
||||
/*
|
||||
* In Tcl 8.7, stop supporting special hacks for legacy Itcl 3.
|
||||
* Itcl 4 doesn't need them. Itcl 3 can be updated to not need them
|
||||
* using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+
|
||||
* releases. Perhaps Tcl 8.7 will add even better public interfaces
|
||||
* supporting all the re-invocation mechanisms extensions like Itcl 3
|
||||
* need. As an absolute last resort, folks who must make Itcl 3 work
|
||||
* unchanged with Tcl 8.7 can remove this line to regain the migration
|
||||
* support. Tcl 9 will no longer offer even that option.
|
||||
*/
|
||||
|
||||
#define AVOID_HACKS_FOR_ITCL 1
|
||||
|
||||
/*
|
||||
* Common include files needed by most of the Tcl source files are included
|
||||
* here, so that system-dependent personalizations for the include files only
|
||||
@@ -38,7 +51,6 @@
|
||||
#include <stdio.h>
|
||||
|
||||
#include <ctype.h>
|
||||
#include <stdarg.h>
|
||||
#ifdef NO_STDLIB_H
|
||||
# include "../compat/stdlib.h"
|
||||
#else
|
||||
@@ -124,6 +136,26 @@ typedef int ptrdiff_t;
|
||||
# define vsnprintf _vsnprintf
|
||||
#endif
|
||||
|
||||
#if !defined(TCL_THREADS)
|
||||
# define TCL_THREADS 1
|
||||
#endif
|
||||
#if !TCL_THREADS
|
||||
# undef TCL_DECLARE_MUTEX
|
||||
# define TCL_DECLARE_MUTEX(name)
|
||||
# undef Tcl_MutexLock
|
||||
# define Tcl_MutexLock(mutexPtr)
|
||||
# undef Tcl_MutexUnlock
|
||||
# define Tcl_MutexUnlock(mutexPtr)
|
||||
# undef Tcl_MutexFinalize
|
||||
# define Tcl_MutexFinalize(mutexPtr)
|
||||
# undef Tcl_ConditionNotify
|
||||
# define Tcl_ConditionNotify(condPtr)
|
||||
# undef Tcl_ConditionWait
|
||||
# define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
|
||||
# undef Tcl_ConditionFinalize
|
||||
# define Tcl_ConditionFinalize(condPtr)
|
||||
#endif
|
||||
|
||||
/*
|
||||
* The following procedures allow namespaces to be customized to support
|
||||
* special name resolution rules for commands/variables.
|
||||
@@ -178,6 +210,9 @@ typedef struct Tcl_ResolverInfo {
|
||||
* - Bug #696893 - variable is either proc-local or in the current
|
||||
* namespace; never follow the second (global) resolution path
|
||||
* - Bug #631741 - do not use special namespace or interp resolvers
|
||||
*
|
||||
* It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
|
||||
* (Bug #835020)
|
||||
*/
|
||||
|
||||
#define TCL_AVOID_RESOLVERS 0x40000
|
||||
@@ -250,7 +285,7 @@ typedef struct Namespace {
|
||||
* strings; values have type (Namespace *). If
|
||||
* NULL, there are no children. */
|
||||
#endif
|
||||
size_t nsId; /* Unique id for the namespace. */
|
||||
unsigned long nsId; /* Unique id for the namespace. */
|
||||
Tcl_Interp *interp; /* The interpreter containing this
|
||||
* namespace. */
|
||||
int flags; /* OR-ed combination of the namespace status
|
||||
@@ -259,7 +294,7 @@ typedef struct Namespace {
|
||||
* frames for this namespace that are on the
|
||||
* Tcl call stack. The namespace won't be
|
||||
* freed until activationCount becomes zero. */
|
||||
size_t refCount; /* Count of references by namespaceName
|
||||
unsigned int refCount; /* Count of references by namespaceName
|
||||
* objects. The namespace can't be freed until
|
||||
* refCount becomes zero. */
|
||||
Tcl_HashTable cmdTable; /* Contains all the commands currently
|
||||
@@ -284,12 +319,12 @@ typedef struct Namespace {
|
||||
* registered using "namespace export". */
|
||||
int maxExportPatterns; /* Mumber of export patterns for which space
|
||||
* is currently allocated. */
|
||||
size_t cmdRefEpoch; /* Incremented if a newly added command
|
||||
unsigned int cmdRefEpoch; /* Incremented if a newly added command
|
||||
* shadows a command for which this namespace
|
||||
* has already cached a Command* pointer; this
|
||||
* causes all its cached Command* pointers to
|
||||
* be invalidated. */
|
||||
size_t resolverEpoch; /* Incremented whenever (a) the name
|
||||
unsigned int resolverEpoch; /* Incremented whenever (a) the name
|
||||
* resolution rules change for this namespace
|
||||
* or (b) a newly added command shadows a
|
||||
* command that is compiled to bytecodes. This
|
||||
@@ -316,7 +351,7 @@ typedef struct Namespace {
|
||||
* LookupCompiledLocal to resolve variable
|
||||
* references within the namespace at compile
|
||||
* time. */
|
||||
size_t exportLookupEpoch; /* Incremented whenever a command is added to
|
||||
unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
|
||||
* a namespace, removed from a namespace or
|
||||
* the exports of a namespace are changed.
|
||||
* Allows TIP#112-driven command lists to be
|
||||
@@ -417,7 +452,7 @@ typedef struct EnsembleConfig {
|
||||
* if the command has been deleted (or never
|
||||
* existed; the global namespace never has an
|
||||
* ensemble command.) */
|
||||
size_t epoch; /* The epoch at which this ensemble's table of
|
||||
unsigned int epoch; /* The epoch at which this ensemble's table of
|
||||
* exported commands is valid. */
|
||||
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
|
||||
* consistent points, this will have the same
|
||||
@@ -530,7 +565,7 @@ typedef struct CommandTrace {
|
||||
struct CommandTrace *nextPtr;
|
||||
/* Next in list of traces associated with a
|
||||
* particular command. */
|
||||
size_t refCount; /* Used to ensure this structure is not
|
||||
size_t refCount; /* Used to ensure this structure is not
|
||||
* deleted too early. Keeps track of how many
|
||||
* pieces of code have a pointer to this
|
||||
* structure. */
|
||||
@@ -603,7 +638,7 @@ typedef struct Var {
|
||||
|
||||
typedef struct VarInHash {
|
||||
Var var;
|
||||
size_t refCount; /* Counts number of active uses of this
|
||||
unsigned int refCount; /* Counts number of active uses of this
|
||||
* variable: 1 for the entry in the hash
|
||||
* table, 1 for each additional variable whose
|
||||
* linkPtr points here, 1 for each nested
|
||||
@@ -935,7 +970,7 @@ typedef struct CompiledLocal {
|
||||
typedef struct Proc {
|
||||
struct Interp *iPtr; /* Interpreter for which this command is
|
||||
* defined. */
|
||||
size_t refCount; /* Reference count: 1 if still present in
|
||||
unsigned int refCount; /* Reference count: 1 if still present in
|
||||
* command table plus 1 for each call to the
|
||||
* procedure that is currently active. This
|
||||
* structure can be freed when refCount
|
||||
@@ -1052,7 +1087,7 @@ typedef struct AssocData {
|
||||
*/
|
||||
|
||||
typedef struct LocalCache {
|
||||
size_t refCount;
|
||||
unsigned int refCount;
|
||||
int numVars;
|
||||
Tcl_Obj *varName0;
|
||||
} LocalCache;
|
||||
@@ -1131,6 +1166,10 @@ typedef struct CallFrame {
|
||||
* field contains an Object reference that has
|
||||
* been confirmed to refer to a class. Part of
|
||||
* TIP#257. */
|
||||
#define FRAME_IS_PRIVATE_DEFINE 0x10
|
||||
/* Marks this frame as being used for private
|
||||
* declarations with [oo::define]. Usually
|
||||
* OR'd with FRAME_IS_OO_DEFINE. TIP#500. */
|
||||
|
||||
/*
|
||||
* TIP #280
|
||||
@@ -1214,7 +1253,7 @@ typedef struct CmdFrame {
|
||||
typedef struct CFWord {
|
||||
CmdFrame *framePtr; /* CmdFrame to access. */
|
||||
int word; /* Index of the word in the command. */
|
||||
size_t refCount; /* Number of times the word is on the
|
||||
unsigned int refCount; /* Number of times the word is on the
|
||||
* stack. */
|
||||
} CFWord;
|
||||
|
||||
@@ -1619,12 +1658,12 @@ typedef struct Command {
|
||||
* recreated). */
|
||||
Namespace *nsPtr; /* Points to the namespace containing this
|
||||
* command. */
|
||||
size_t refCount; /* 1 if in command hashtable plus 1 for each
|
||||
unsigned int refCount; /* 1 if in command hashtable plus 1 for each
|
||||
* reference from a CmdName Tcl object
|
||||
* representing a command's name in a ByteCode
|
||||
* instruction sequence. This structure can be
|
||||
* freed when refCount becomes zero. */
|
||||
size_t cmdEpoch; /* Incremented to invalidate any references
|
||||
unsigned int cmdEpoch; /* Incremented to invalidate any references
|
||||
* that point to this command when it is
|
||||
* renamed, deleted, hidden, or exposed. */
|
||||
CompileProc *compileProc; /* Procedure called to compile command. NULL
|
||||
@@ -1758,31 +1797,41 @@ typedef struct AllocCache {
|
||||
|
||||
typedef struct Interp {
|
||||
/*
|
||||
* The first two fields were named "result" and "freeProc" in earlier
|
||||
* versions of Tcl. They are no longer used within Tcl, and are no
|
||||
* longer available to be accessed by extensions. However, they cannot
|
||||
* be removed. Why? There is a deployed base of stub-enabled extensions
|
||||
* that query the value of iPtr->stubTable. For them to continue to work,
|
||||
* the location of the field "stubTable" within the Interp struct cannot
|
||||
* change. The most robust way to assure that is to leave all fields up to
|
||||
* that one undisturbed.
|
||||
* Note: the first three fields must match exactly the fields in a
|
||||
* Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
|
||||
* other.
|
||||
*
|
||||
* The interpreter's result is held in both the string and the
|
||||
* objResultPtr fields. These fields hold, respectively, the result's
|
||||
* string or object value. The interpreter's result is always in the
|
||||
* result field if that is non-empty, otherwise it is in objResultPtr.
|
||||
* The two fields are kept consistent unless some C code sets
|
||||
* interp->result directly. Programs should not access result and
|
||||
* objResultPtr directly; instead, they should always get and set the
|
||||
* result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
|
||||
* Tcl_GetStringResult. See the SetResult man page for details.
|
||||
*/
|
||||
|
||||
const char *legacyResult;
|
||||
void (*legacyFreeProc) (void);
|
||||
char *result; /* If the last command returned a string
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
Tcl_FreeProc *freeProc; /* Zero means a string result is statically
|
||||
* allocated. TCL_DYNAMIC means string result
|
||||
* was allocated with ckalloc and should be
|
||||
* freed with ckfree. Other values give
|
||||
* address of procedure to invoke to free the
|
||||
* string result. Tcl_Eval must free it before
|
||||
* executing next command. */
|
||||
int errorLine; /* When TCL_ERROR is returned, this gives the
|
||||
* line number in the command where the error
|
||||
* occurred (1 means first line). */
|
||||
const struct TclStubs *stubTable;
|
||||
/* Pointer to the exported Tcl stub table. In
|
||||
* ancient pre-8.1 versions of Tcl this was a
|
||||
* pointer to the objResultPtr or a pointer to a
|
||||
* buckets array in a hash table. Deployed stubs
|
||||
* enabled extensions check for a NULL pointer value
|
||||
* and for a TCL_STUBS_MAGIC value to verify they
|
||||
* are not [load]ing into one of those pre-stubs
|
||||
* interps.
|
||||
*/
|
||||
/* Pointer to the exported Tcl stub table. On
|
||||
* previous versions of Tcl this is a pointer
|
||||
* to the objResultPtr or a pointer to a
|
||||
* buckets array in a hash table. We therefore
|
||||
* have to do some careful checking before we
|
||||
* can use this. */
|
||||
|
||||
TclHandle handle; /* Handle used to keep track of when this
|
||||
* interp is deleted. */
|
||||
@@ -1795,7 +1844,15 @@ typedef struct Interp {
|
||||
ClientData interpInfo; /* Information used by tclInterp.c to keep
|
||||
* track of master/slave interps on a
|
||||
* per-interp basis. */
|
||||
void (*optimizer)(void *envPtr);
|
||||
union {
|
||||
void (*optimizer)(void *envPtr);
|
||||
Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The
|
||||
* unused space in interp was repurposed for
|
||||
* pluggable bytecode optimizers. The core
|
||||
* contains one optimizer, which can be
|
||||
* selectively overridden by extensions. */
|
||||
} extra;
|
||||
|
||||
/*
|
||||
* Information related to procedures and variables. See tclProc.c and
|
||||
* tclVar.c for usage.
|
||||
@@ -1824,6 +1881,25 @@ typedef struct Interp {
|
||||
Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
|
||||
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
|
||||
|
||||
/*
|
||||
* Information used by Tcl_AppendResult to keep track of partial results.
|
||||
* See Tcl_AppendResult code for details.
|
||||
*/
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
char *appendResult; /* Storage space for results generated by
|
||||
* Tcl_AppendResult. Ckalloc-ed. NULL means
|
||||
* not yet allocated. */
|
||||
int appendAvl; /* Total amount of space available at
|
||||
* partialResult. */
|
||||
int appendUsed; /* Number of non-null bytes currently stored
|
||||
* at partialResult. */
|
||||
#else
|
||||
char *appendResultDontUse;
|
||||
int appendAvlDontUse;
|
||||
int appendUsedDontUse;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Information about packages. Used only in tclPkg.c.
|
||||
*/
|
||||
@@ -1846,12 +1922,13 @@ typedef struct Interp {
|
||||
* Normally zero, but may be set before
|
||||
* calling Tcl_Eval. See below for valid
|
||||
* values. */
|
||||
int unused1; /* No longer used (was termOffset) */
|
||||
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
|
||||
* objects holding literals of scripts
|
||||
* compiled by the interpreter. Indexed by the
|
||||
* string representations of literals. Used to
|
||||
* avoid creating duplicate objects. */
|
||||
size_t compileEpoch; /* Holds the current "compilation epoch" for
|
||||
unsigned int compileEpoch; /* Holds the current "compilation epoch" for
|
||||
* this interpreter. This is incremented to
|
||||
* invalidate existing ByteCodes when, e.g., a
|
||||
* command with a compile procedure is
|
||||
@@ -1883,6 +1960,14 @@ typedef struct Interp {
|
||||
* string. Returned by Tcl_ObjSetVar2 when
|
||||
* variable traces change a variable in a
|
||||
* gross way. */
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
# if !defined(TCL_NO_DEPRECATED)
|
||||
char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
|
||||
/* Static space holding small results. */
|
||||
# else
|
||||
char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
|
||||
# endif
|
||||
#endif
|
||||
Tcl_Obj *objResultPtr; /* If the last command returned an object
|
||||
* result, this points to it. Should not be
|
||||
* accessed directly; see comment above. */
|
||||
@@ -2325,7 +2410,7 @@ typedef enum TclEolTranslation {
|
||||
*/
|
||||
|
||||
typedef struct List {
|
||||
size_t refCount;
|
||||
unsigned int refCount;
|
||||
int maxElemCount; /* Total number of element array slots. */
|
||||
int elemCount; /* Current number of list elements. */
|
||||
int canonicalFlag; /* Set if the string representation was
|
||||
@@ -2394,9 +2479,10 @@ typedef struct List {
|
||||
*/
|
||||
|
||||
#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
|
||||
(((objPtr)->typePtr == &tclIntType \
|
||||
|| (objPtr)->typePtr == &tclBooleanType) \
|
||||
(((objPtr)->typePtr == &tclIntType) \
|
||||
? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
|
||||
: ((objPtr)->typePtr == &tclBooleanType) \
|
||||
? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
|
||||
: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
|
||||
|
||||
#ifdef TCL_WIDE_INT_IS_LONG
|
||||
@@ -2562,7 +2648,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
|
||||
*----------------------------------------------------------------
|
||||
*/
|
||||
|
||||
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
|
||||
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
|
||||
Tcl_Encoding *encodingPtr);
|
||||
|
||||
/*
|
||||
@@ -2574,9 +2660,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
|
||||
*/
|
||||
|
||||
typedef struct ProcessGlobalValue {
|
||||
size_t epoch; /* Epoch counter to detect changes in the
|
||||
unsigned int epoch; /* Epoch counter to detect changes in the
|
||||
* master value. */
|
||||
size_t numBytes; /* Length of the master string. */
|
||||
unsigned int numBytes; /* Length of the master string. */
|
||||
char *value; /* The master string value. */
|
||||
Tcl_Encoding encoding; /* system encoding when master string was
|
||||
* initialized. */
|
||||
@@ -2840,6 +2926,9 @@ MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
|
||||
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
|
||||
MODULE_SCOPE int TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
|
||||
Var *arrayPtr, Tcl_Obj *name, int index);
|
||||
MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
|
||||
const char *value);
|
||||
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
|
||||
@@ -2855,19 +2944,13 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
|
||||
Tcl_Obj *originObjPtr);
|
||||
MODULE_SCOPE int TclConvertElement(const char *src, int length,
|
||||
char *dst, int flags);
|
||||
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
ClientData clientData,
|
||||
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc, ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
|
||||
Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *nameNamespacePtr,
|
||||
Tcl_Namespace *ensembleNamespacePtr,
|
||||
int flags);
|
||||
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
|
||||
const char *name, Tcl_Namespace *nameNamespacePtr,
|
||||
Tcl_Namespace *ensembleNamespacePtr, int flags);
|
||||
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
|
||||
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
|
||||
const char *dict, int dictLength,
|
||||
@@ -2894,9 +2977,9 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
|
||||
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
|
||||
Tcl_DString *toAppendPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
|
||||
MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
|
||||
Tcl_Obj *const *objv, int objc, int *objcPtr);
|
||||
MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(Tcl_Interp *interp,
|
||||
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
|
||||
Tcl_Namespace *namespacePtr);
|
||||
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
|
||||
MODULE_SCOPE void TclFinalizeAsync(void);
|
||||
@@ -2924,15 +3007,11 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
|
||||
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
|
||||
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
|
||||
const char *attributeName, int *indexPtr);
|
||||
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
|
||||
Tcl_Interp *interp,
|
||||
const char *cmdName,
|
||||
Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc,
|
||||
Tcl_ObjCmdProc *nreProc,
|
||||
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
|
||||
const char *cmdName, Tcl_Namespace *nsPtr,
|
||||
Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
|
||||
ClientData clientData,
|
||||
Tcl_CmdDeleteProc *deleteProc);
|
||||
|
||||
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
|
||||
const char *encodingName);
|
||||
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
|
||||
@@ -3061,7 +3140,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
|
||||
int stackSize, int flags);
|
||||
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
|
||||
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
|
||||
size_t *lengthPtr, Tcl_Encoding *encodingPtr);
|
||||
unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
|
||||
MODULE_SCOPE void TclpInitLock(void);
|
||||
MODULE_SCOPE void TclpInitPlatform(void);
|
||||
MODULE_SCOPE void TclpInitUnlock(void);
|
||||
@@ -3113,7 +3192,8 @@ MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
|
||||
Tcl_Obj *cmdPrefix);
|
||||
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
|
||||
mp_int *bignumValue);
|
||||
MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
|
||||
Command *cmdPtr);
|
||||
MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
|
||||
@@ -3125,6 +3205,12 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
|
||||
Tcl_Obj *bad, Tcl_Obj *fix);
|
||||
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
|
||||
int numBytes);
|
||||
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
|
||||
MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
|
||||
int checkEq, int nocase, int reqlength);
|
||||
MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[], int *nocase,
|
||||
int *reqlength);
|
||||
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
|
||||
const char *pattern, int ptnLen, int flags);
|
||||
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
|
||||
@@ -3173,8 +3259,8 @@ MODULE_SCOPE void * TclpThreadCreateKey(void);
|
||||
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
|
||||
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
|
||||
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
|
||||
|
||||
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
|
||||
MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
|
||||
const char *msg, int length);
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
@@ -3196,6 +3282,11 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
|
||||
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
#endif
|
||||
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const objv[]);
|
||||
@@ -3929,7 +4020,6 @@ MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
|
||||
MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
|
||||
Tcl_Parse *parsePtr, Command *cmdPtr,
|
||||
struct CompileEnv *envPtr);
|
||||
MODULE_SCOPE int TclCheckEmptyString(Tcl_Obj *objPtr);
|
||||
|
||||
/*
|
||||
* Routines that provide the [string] ensemble functionality. Possible
|
||||
@@ -4023,7 +4113,7 @@ typedef enum TclProcessWaitStatus {
|
||||
TCL_PROCESS_EXITED = 1, /* Process has exited. */
|
||||
TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
|
||||
TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
|
||||
TCL_PROCESS_UNKNOWN_STATUS = 4
|
||||
TCL_PROCESS_UNKNOWN_STATUS = 4
|
||||
/* Child wait status didn't make sense. */
|
||||
} TclProcessWaitStatus;
|
||||
|
||||
@@ -4134,6 +4224,10 @@ typedef const char *TclDTraceStr;
|
||||
} \
|
||||
}
|
||||
|
||||
#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
|
||||
# define USE_THREAD_ALLOC 1
|
||||
#endif
|
||||
|
||||
#if defined(PURIFY)
|
||||
|
||||
/*
|
||||
@@ -4151,7 +4245,7 @@ typedef const char *TclDTraceStr;
|
||||
|
||||
#undef USE_THREAD_ALLOC
|
||||
#undef USE_TCLALLOC
|
||||
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
|
||||
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)
|
||||
|
||||
/*
|
||||
* The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
|
||||
@@ -4216,7 +4310,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
|
||||
# define USE_TCLALLOC 0
|
||||
#endif
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/* declared in tclObj.c */
|
||||
MODULE_SCOPE Tcl_Mutex tclObjMutex;
|
||||
#endif
|
||||
@@ -4476,12 +4570,9 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
|
||||
*/
|
||||
|
||||
MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
|
||||
|
||||
#define TclIsPureDict(objPtr) \
|
||||
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
|
||||
|
||||
#define TclIsPureList(objPtr) \
|
||||
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------
|
||||
|
||||
+202
-82
@@ -28,6 +28,22 @@
|
||||
# endif
|
||||
#endif
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
|
||||
/* Those macro's are especially for Itcl 3.4 compatibility */
|
||||
# define tclCreateNamespace tcl_CreateNamespace
|
||||
# define tclDeleteNamespace tcl_DeleteNamespace
|
||||
# define tclAppendExportList tcl_AppendExportList
|
||||
# define tclExport tcl_Export
|
||||
# define tclImport tcl_Import
|
||||
# define tclForgetImport tcl_ForgetImport
|
||||
# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
|
||||
# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
|
||||
# define tclFindNamespace tcl_FindNamespace
|
||||
# define tclFindCommand tcl_FindCommand
|
||||
# define tclGetCommandFromObj tcl_GetCommandFromObj
|
||||
# define tclGetCommandFullName tcl_GetCommandFullName
|
||||
#endif /* !defined(TCL_NO_DEPRECATED) */
|
||||
|
||||
/*
|
||||
* WARNING: This file is automatically generated by the tools/genStubs.tcl
|
||||
* script. Any modifications to the function declarations below should be made
|
||||
@@ -58,7 +74,11 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
|
||||
/* 7 */
|
||||
EXTERN int TclCopyAndCollapse(int count, const char *src,
|
||||
char *dst);
|
||||
/* Slot 8 is reserved */
|
||||
/* 8 */
|
||||
TCL_DEPRECATED("")
|
||||
int TclCopyChannelOld(Tcl_Interp *interp,
|
||||
Tcl_Channel inChan, Tcl_Channel outChan,
|
||||
int toRead, Tcl_Obj *cmdPtr);
|
||||
/* 9 */
|
||||
EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc,
|
||||
const char **argv, Tcl_Pid **pidArrayPtr,
|
||||
@@ -132,7 +152,7 @@ EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str,
|
||||
/* 41 */
|
||||
EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command);
|
||||
/* 42 */
|
||||
EXTERN const char * TclpGetUserHome(const char *name,
|
||||
EXTERN CONST86 char * TclpGetUserHome(const char *name,
|
||||
Tcl_DString *bufferPtr);
|
||||
/* Slot 43 is reserved */
|
||||
/* 44 */
|
||||
@@ -198,7 +218,9 @@ EXTERN void TclpFree(char *ptr);
|
||||
EXTERN unsigned long TclpGetClicks(void);
|
||||
/* 76 */
|
||||
EXTERN unsigned long TclpGetSeconds(void);
|
||||
/* Slot 77 is reserved */
|
||||
/* 77 */
|
||||
TCL_DEPRECATED("")
|
||||
void TclpGetTime(Tcl_Time *time);
|
||||
/* Slot 78 is reserved */
|
||||
/* Slot 79 is reserved */
|
||||
/* Slot 80 is reserved */
|
||||
@@ -210,7 +232,11 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size);
|
||||
/* Slot 85 is reserved */
|
||||
/* Slot 86 is reserved */
|
||||
/* Slot 87 is reserved */
|
||||
/* Slot 88 is reserved */
|
||||
/* 88 */
|
||||
TCL_DEPRECATED("")
|
||||
char * TclPrecTraceProc(ClientData clientData,
|
||||
Tcl_Interp *interp, const char *name1,
|
||||
const char *name2, int flags);
|
||||
/* 89 */
|
||||
EXTERN int TclPreventAliasLoop(Tcl_Interp *interp,
|
||||
Tcl_Interp *cmdInterp, Tcl_Command cmd);
|
||||
@@ -237,13 +263,15 @@ EXTERN int TclServiceIdle(void);
|
||||
/* Slot 99 is reserved */
|
||||
/* Slot 100 is reserved */
|
||||
/* 101 */
|
||||
EXTERN const char * TclSetPreInitScript(const char *string);
|
||||
EXTERN CONST86 char * TclSetPreInitScript(const char *string);
|
||||
/* 102 */
|
||||
EXTERN void TclSetupEnv(Tcl_Interp *interp);
|
||||
/* 103 */
|
||||
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
|
||||
const char *proto, int *portPtr);
|
||||
/* Slot 104 is reserved */
|
||||
/* 104 */
|
||||
TCL_DEPRECATED("")
|
||||
int TclSockMinimumBuffersOld(int sock, int size);
|
||||
/* Slot 105 is reserved */
|
||||
/* Slot 106 is reserved */
|
||||
/* Slot 107 is reserved */
|
||||
@@ -259,12 +287,25 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
|
||||
Tcl_ResolveCmdProc *cmdProc,
|
||||
Tcl_ResolveVarProc *varProc,
|
||||
Tcl_ResolveCompiledVarProc *compiledVarProc);
|
||||
/* Slot 112 is reserved */
|
||||
/* Slot 113 is reserved */
|
||||
/* Slot 114 is reserved */
|
||||
/* Slot 115 is reserved */
|
||||
/* Slot 116 is reserved */
|
||||
/* Slot 117 is reserved */
|
||||
/* 112 */
|
||||
EXTERN int TclAppendExportList(Tcl_Interp *interp,
|
||||
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
|
||||
/* 113 */
|
||||
EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp,
|
||||
const char *name, ClientData clientData,
|
||||
Tcl_NamespaceDeleteProc *deleteProc);
|
||||
/* 114 */
|
||||
EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr);
|
||||
/* 115 */
|
||||
EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int resetListFirst);
|
||||
/* 116 */
|
||||
EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags);
|
||||
/* 117 */
|
||||
EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags);
|
||||
/* 118 */
|
||||
EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp,
|
||||
const char *name, Tcl_ResolverInfo *resInfo);
|
||||
@@ -276,15 +317,25 @@ EXTERN int Tcl_GetNamespaceResolvers(
|
||||
EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
|
||||
const char *name,
|
||||
Tcl_Namespace *contextNsPtr, int flags);
|
||||
/* Slot 121 is reserved */
|
||||
/* Slot 122 is reserved */
|
||||
/* Slot 123 is reserved */
|
||||
/* Slot 124 is reserved */
|
||||
/* Slot 125 is reserved */
|
||||
/* 121 */
|
||||
EXTERN int TclForgetImport(Tcl_Interp *interp,
|
||||
Tcl_Namespace *nsPtr, const char *pattern);
|
||||
/* 122 */
|
||||
EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp,
|
||||
Tcl_Obj *objPtr);
|
||||
/* 123 */
|
||||
EXTERN void TclGetCommandFullName(Tcl_Interp *interp,
|
||||
Tcl_Command command, Tcl_Obj *objPtr);
|
||||
/* 124 */
|
||||
EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp);
|
||||
/* 125 */
|
||||
EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp);
|
||||
/* 126 */
|
||||
EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp,
|
||||
Tcl_Var variable, Tcl_Obj *objPtr);
|
||||
/* Slot 127 is reserved */
|
||||
/* 127 */
|
||||
EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
|
||||
const char *pattern, int allowOverwrite);
|
||||
/* 128 */
|
||||
EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
|
||||
/* 129 */
|
||||
@@ -302,7 +353,9 @@ EXTERN void Tcl_SetNamespaceResolvers(
|
||||
Tcl_ResolveCompiledVarProc *compiledVarProc);
|
||||
/* 132 */
|
||||
EXTERN int TclpHasSockets(Tcl_Interp *interp);
|
||||
/* Slot 133 is reserved */
|
||||
/* 133 */
|
||||
TCL_DEPRECATED("")
|
||||
struct tm * TclpGetDate(const time_t *time, int useGMT);
|
||||
/* Slot 134 is reserved */
|
||||
/* Slot 135 is reserved */
|
||||
/* Slot 136 is reserved */
|
||||
@@ -350,8 +403,12 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
|
||||
/* 157 */
|
||||
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
|
||||
const char *varName);
|
||||
/* Slot 158 is reserved */
|
||||
/* Slot 159 is reserved */
|
||||
/* 158 */
|
||||
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
|
||||
void TclSetStartupScriptFileName(const char *filename);
|
||||
/* 159 */
|
||||
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
|
||||
const char * TclGetStartupScriptFileName(void);
|
||||
/* Slot 160 is reserved */
|
||||
/* 161 */
|
||||
EXTERN int TclChannelTransform(Tcl_Interp *interp,
|
||||
@@ -369,8 +426,12 @@ EXTERN void TclpSetInitialEncodings(void);
|
||||
EXTERN int TclListObjSetElement(Tcl_Interp *interp,
|
||||
Tcl_Obj *listPtr, int index,
|
||||
Tcl_Obj *valuePtr);
|
||||
/* Slot 167 is reserved */
|
||||
/* Slot 168 is reserved */
|
||||
/* 167 */
|
||||
TCL_DEPRECATED("use public Tcl_SetStartupScript()")
|
||||
void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
|
||||
/* 168 */
|
||||
TCL_DEPRECATED("use public Tcl_GetStartupScript()")
|
||||
Tcl_Obj * TclGetStartupScriptPath(void);
|
||||
/* 169 */
|
||||
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
|
||||
unsigned long n);
|
||||
@@ -402,12 +463,19 @@ EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr);
|
||||
EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
|
||||
const char *part2, const char *operation,
|
||||
const char *reason);
|
||||
/* Slot 178 is reserved */
|
||||
/* Slot 179 is reserved */
|
||||
/* 178 */
|
||||
EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr,
|
||||
const char *encodingName);
|
||||
/* 179 */
|
||||
EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr);
|
||||
/* Slot 180 is reserved */
|
||||
/* Slot 181 is reserved */
|
||||
/* Slot 182 is reserved */
|
||||
/* Slot 183 is reserved */
|
||||
/* 182 */
|
||||
TCL_DEPRECATED("")
|
||||
struct tm * TclpLocaltime(const time_t *clock);
|
||||
/* 183 */
|
||||
TCL_DEPRECATED("")
|
||||
struct tm * TclpGmtime(const time_t *clock);
|
||||
/* Slot 184 is reserved */
|
||||
/* Slot 185 is reserved */
|
||||
/* Slot 186 is reserved */
|
||||
@@ -510,7 +578,9 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
|
||||
/* 235 */
|
||||
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
|
||||
Namespace *nsPtr);
|
||||
/* Slot 236 is reserved */
|
||||
/* 236 */
|
||||
TCL_DEPRECATED("use Tcl_BackgroundException")
|
||||
void TclBackgroundException(Tcl_Interp *interp, int code);
|
||||
/* 237 */
|
||||
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
|
||||
/* 238 */
|
||||
@@ -592,7 +662,7 @@ typedef struct TclIntStubs {
|
||||
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
|
||||
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
|
||||
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
|
||||
void (*reserved8)(void);
|
||||
TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
|
||||
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
|
||||
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
|
||||
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
|
||||
@@ -626,7 +696,7 @@ typedef struct TclIntStubs {
|
||||
TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
|
||||
int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
|
||||
Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
|
||||
const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
|
||||
CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
|
||||
void (*reserved43)(void);
|
||||
int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
|
||||
int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
|
||||
@@ -661,7 +731,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclpFree) (char *ptr); /* 74 */
|
||||
unsigned long (*tclpGetClicks) (void); /* 75 */
|
||||
unsigned long (*tclpGetSeconds) (void); /* 76 */
|
||||
void (*reserved77)(void);
|
||||
TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
|
||||
void (*reserved78)(void);
|
||||
void (*reserved79)(void);
|
||||
void (*reserved80)(void);
|
||||
@@ -672,7 +742,7 @@ typedef struct TclIntStubs {
|
||||
void (*reserved85)(void);
|
||||
void (*reserved86)(void);
|
||||
void (*reserved87)(void);
|
||||
void (*reserved88)(void);
|
||||
TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
|
||||
int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
|
||||
void (*reserved90)(void);
|
||||
void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
|
||||
@@ -685,10 +755,10 @@ typedef struct TclIntStubs {
|
||||
int (*tclServiceIdle) (void); /* 98 */
|
||||
void (*reserved99)(void);
|
||||
void (*reserved100)(void);
|
||||
const char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
|
||||
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
|
||||
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
|
||||
void (*reserved104)(void);
|
||||
TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
|
||||
void (*reserved105)(void);
|
||||
void (*reserved106)(void);
|
||||
void (*reserved107)(void);
|
||||
@@ -696,28 +766,28 @@ typedef struct TclIntStubs {
|
||||
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
|
||||
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
|
||||
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
|
||||
void (*reserved112)(void);
|
||||
void (*reserved113)(void);
|
||||
void (*reserved114)(void);
|
||||
void (*reserved115)(void);
|
||||
void (*reserved116)(void);
|
||||
void (*reserved117)(void);
|
||||
int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
|
||||
Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
|
||||
void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
|
||||
int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
|
||||
Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
|
||||
Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
|
||||
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
|
||||
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
|
||||
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
|
||||
void (*reserved121)(void);
|
||||
void (*reserved122)(void);
|
||||
void (*reserved123)(void);
|
||||
void (*reserved124)(void);
|
||||
void (*reserved125)(void);
|
||||
int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
|
||||
Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
|
||||
void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
|
||||
Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
|
||||
Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
|
||||
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
|
||||
void (*reserved127)(void);
|
||||
int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
|
||||
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
|
||||
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
|
||||
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
|
||||
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
|
||||
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
|
||||
void (*reserved133)(void);
|
||||
TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
|
||||
void (*reserved134)(void);
|
||||
void (*reserved135)(void);
|
||||
void (*reserved136)(void);
|
||||
@@ -742,8 +812,8 @@ typedef struct TclIntStubs {
|
||||
void (*reserved155)(void);
|
||||
void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
|
||||
Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
|
||||
void (*reserved158)(void);
|
||||
void (*reserved159)(void);
|
||||
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
|
||||
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
|
||||
void (*reserved160)(void);
|
||||
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
|
||||
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
|
||||
@@ -751,8 +821,8 @@ typedef struct TclIntStubs {
|
||||
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
|
||||
void (*tclpSetInitialEncodings) (void); /* 165 */
|
||||
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
|
||||
void (*reserved167)(void);
|
||||
void (*reserved168)(void);
|
||||
TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
|
||||
TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
|
||||
int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
|
||||
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
|
||||
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
|
||||
@@ -762,12 +832,12 @@ typedef struct TclIntStubs {
|
||||
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
|
||||
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
|
||||
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
|
||||
void (*reserved178)(void);
|
||||
void (*reserved179)(void);
|
||||
void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
|
||||
Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
|
||||
void (*reserved180)(void);
|
||||
void (*reserved181)(void);
|
||||
void (*reserved182)(void);
|
||||
void (*reserved183)(void);
|
||||
TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
|
||||
TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
|
||||
void (*reserved184)(void);
|
||||
void (*reserved185)(void);
|
||||
void (*reserved186)(void);
|
||||
@@ -820,7 +890,7 @@ typedef struct TclIntStubs {
|
||||
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
|
||||
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
|
||||
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
|
||||
void (*reserved236)(void);
|
||||
TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
|
||||
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
|
||||
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
|
||||
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
|
||||
@@ -867,7 +937,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclCleanupCommand) /* 6 */
|
||||
#define TclCopyAndCollapse \
|
||||
(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
|
||||
/* Slot 8 is reserved */
|
||||
#define TclCopyChannelOld \
|
||||
(tclIntStubsPtr->tclCopyChannelOld) /* 8 */
|
||||
#define TclCreatePipeline \
|
||||
(tclIntStubsPtr->tclCreatePipeline) /* 9 */
|
||||
#define TclCreateProc \
|
||||
@@ -974,7 +1045,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclpGetClicks) /* 75 */
|
||||
#define TclpGetSeconds \
|
||||
(tclIntStubsPtr->tclpGetSeconds) /* 76 */
|
||||
/* Slot 77 is reserved */
|
||||
#define TclpGetTime \
|
||||
(tclIntStubsPtr->tclpGetTime) /* 77 */
|
||||
/* Slot 78 is reserved */
|
||||
/* Slot 79 is reserved */
|
||||
/* Slot 80 is reserved */
|
||||
@@ -986,7 +1058,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
/* Slot 85 is reserved */
|
||||
/* Slot 86 is reserved */
|
||||
/* Slot 87 is reserved */
|
||||
/* Slot 88 is reserved */
|
||||
#define TclPrecTraceProc \
|
||||
(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
|
||||
#define TclPreventAliasLoop \
|
||||
(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
|
||||
/* Slot 90 is reserved */
|
||||
@@ -1012,7 +1085,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclSetupEnv) /* 102 */
|
||||
#define TclSockGetPort \
|
||||
(tclIntStubsPtr->tclSockGetPort) /* 103 */
|
||||
/* Slot 104 is reserved */
|
||||
#define TclSockMinimumBuffersOld \
|
||||
(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
|
||||
/* Slot 105 is reserved */
|
||||
/* Slot 106 is reserved */
|
||||
/* Slot 107 is reserved */
|
||||
@@ -1024,26 +1098,38 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
|
||||
#define Tcl_AddInterpResolvers \
|
||||
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
|
||||
/* Slot 112 is reserved */
|
||||
/* Slot 113 is reserved */
|
||||
/* Slot 114 is reserved */
|
||||
/* Slot 115 is reserved */
|
||||
/* Slot 116 is reserved */
|
||||
/* Slot 117 is reserved */
|
||||
#define TclAppendExportList \
|
||||
(tclIntStubsPtr->tclAppendExportList) /* 112 */
|
||||
#define TclCreateNamespace \
|
||||
(tclIntStubsPtr->tclCreateNamespace) /* 113 */
|
||||
#define TclDeleteNamespace \
|
||||
(tclIntStubsPtr->tclDeleteNamespace) /* 114 */
|
||||
#define TclExport \
|
||||
(tclIntStubsPtr->tclExport) /* 115 */
|
||||
#define TclFindCommand \
|
||||
(tclIntStubsPtr->tclFindCommand) /* 116 */
|
||||
#define TclFindNamespace \
|
||||
(tclIntStubsPtr->tclFindNamespace) /* 117 */
|
||||
#define Tcl_GetInterpResolvers \
|
||||
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
|
||||
#define Tcl_GetNamespaceResolvers \
|
||||
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
|
||||
#define Tcl_FindNamespaceVar \
|
||||
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
|
||||
/* Slot 121 is reserved */
|
||||
/* Slot 122 is reserved */
|
||||
/* Slot 123 is reserved */
|
||||
/* Slot 124 is reserved */
|
||||
/* Slot 125 is reserved */
|
||||
#define TclForgetImport \
|
||||
(tclIntStubsPtr->tclForgetImport) /* 121 */
|
||||
#define TclGetCommandFromObj \
|
||||
(tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
|
||||
#define TclGetCommandFullName \
|
||||
(tclIntStubsPtr->tclGetCommandFullName) /* 123 */
|
||||
#define TclGetCurrentNamespace_ \
|
||||
(tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
|
||||
#define TclGetGlobalNamespace_ \
|
||||
(tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
|
||||
#define Tcl_GetVariableFullName \
|
||||
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
|
||||
/* Slot 127 is reserved */
|
||||
#define TclImport \
|
||||
(tclIntStubsPtr->tclImport) /* 127 */
|
||||
#define Tcl_PopCallFrame \
|
||||
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
|
||||
#define Tcl_PushCallFrame \
|
||||
@@ -1054,7 +1140,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
|
||||
#define TclpHasSockets \
|
||||
(tclIntStubsPtr->tclpHasSockets) /* 132 */
|
||||
/* Slot 133 is reserved */
|
||||
#define TclpGetDate \
|
||||
(tclIntStubsPtr->tclpGetDate) /* 133 */
|
||||
/* Slot 134 is reserved */
|
||||
/* Slot 135 is reserved */
|
||||
/* Slot 136 is reserved */
|
||||
@@ -1095,8 +1182,10 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclRegError) /* 156 */
|
||||
#define TclVarTraceExists \
|
||||
(tclIntStubsPtr->tclVarTraceExists) /* 157 */
|
||||
/* Slot 158 is reserved */
|
||||
/* Slot 159 is reserved */
|
||||
#define TclSetStartupScriptFileName \
|
||||
(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
|
||||
#define TclGetStartupScriptFileName \
|
||||
(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
|
||||
/* Slot 160 is reserved */
|
||||
#define TclChannelTransform \
|
||||
(tclIntStubsPtr->tclChannelTransform) /* 161 */
|
||||
@@ -1110,8 +1199,10 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
|
||||
#define TclListObjSetElement \
|
||||
(tclIntStubsPtr->tclListObjSetElement) /* 166 */
|
||||
/* Slot 167 is reserved */
|
||||
/* Slot 168 is reserved */
|
||||
#define TclSetStartupScriptPath \
|
||||
(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
|
||||
#define TclGetStartupScriptPath \
|
||||
(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
|
||||
#define TclpUtfNcmp2 \
|
||||
(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
|
||||
#define TclCheckInterpTraces \
|
||||
@@ -1129,12 +1220,16 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclCleanupVar) /* 176 */
|
||||
#define TclVarErrMsg \
|
||||
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
|
||||
/* Slot 178 is reserved */
|
||||
/* Slot 179 is reserved */
|
||||
#define TclSetStartupScript \
|
||||
(tclIntStubsPtr->tclSetStartupScript) /* 178 */
|
||||
#define TclGetStartupScript \
|
||||
(tclIntStubsPtr->tclGetStartupScript) /* 179 */
|
||||
/* Slot 180 is reserved */
|
||||
/* Slot 181 is reserved */
|
||||
/* Slot 182 is reserved */
|
||||
/* Slot 183 is reserved */
|
||||
#define TclpLocaltime \
|
||||
(tclIntStubsPtr->tclpLocaltime) /* 182 */
|
||||
#define TclpGmtime \
|
||||
(tclIntStubsPtr->tclpGmtime) /* 183 */
|
||||
/* Slot 184 is reserved */
|
||||
/* Slot 185 is reserved */
|
||||
/* Slot 186 is reserved */
|
||||
@@ -1215,7 +1310,8 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
|
||||
#define TclInitVarHashTable \
|
||||
(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
|
||||
/* Slot 236 is reserved */
|
||||
#define TclBackgroundException \
|
||||
(tclIntStubsPtr->tclBackgroundException) /* 236 */
|
||||
#define TclResetCancellation \
|
||||
(tclIntStubsPtr->tclResetCancellation) /* 237 */
|
||||
#define TclNRInterpProc \
|
||||
@@ -1264,4 +1360,28 @@ extern const TclIntStubs *tclIntStubsPtr;
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
|
||||
#if defined(USE_TCL_STUBS)
|
||||
# undef TclGetStartupScriptFileName
|
||||
# undef TclSetStartupScriptFileName
|
||||
# undef TclGetStartupScriptPath
|
||||
# undef TclSetStartupScriptPath
|
||||
# undef TclBackgroundException
|
||||
# undef TclSetStartupScript
|
||||
# undef TclGetStartupScript
|
||||
# undef TclCreateNamespace
|
||||
# undef TclDeleteNamespace
|
||||
# undef TclAppendExportList
|
||||
# undef TclExport
|
||||
# undef TclImport
|
||||
# undef TclForgetImport
|
||||
# undef TclGetCurrentNamespace_
|
||||
# undef TclGetGlobalNamespace_
|
||||
# undef TclFindNamespace
|
||||
# undef TclFindCommand
|
||||
# undef TclGetCommandFromObj
|
||||
# undef TclGetCommandFullName
|
||||
# undef TclCopyChannelOld
|
||||
# undef TclSockMinimumBuffersOld
|
||||
#endif
|
||||
|
||||
#endif /* _TCLINTDECLS */
|
||||
|
||||
+116
-60
@@ -13,11 +13,6 @@
|
||||
#ifndef _TCLINTPLATDECLS
|
||||
#define _TCLINTPLATDECLS
|
||||
|
||||
#ifdef _WIN32
|
||||
# define Tcl_DirEntry void
|
||||
# define DIR void
|
||||
#endif
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#ifdef BUILD_tcl
|
||||
# define TCL_STORAGE_CLASS DLLEXPORT
|
||||
@@ -71,10 +66,14 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* Slot 10 is reserved */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* Slot 13 is reserved */
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
@@ -103,19 +102,29 @@ EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
/* 0 */
|
||||
EXTERN void TclWinConvertError(DWORD errCode);
|
||||
/* Slot 1 is reserved */
|
||||
/* Slot 2 is reserved */
|
||||
/* Slot 3 is reserved */
|
||||
/* 1 */
|
||||
EXTERN void TclWinConvertWSAError(DWORD errCode);
|
||||
/* 2 */
|
||||
EXTERN struct servent * TclWinGetServByName(const char *nm,
|
||||
const char *proto);
|
||||
/* 3 */
|
||||
EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname,
|
||||
char *optval, int *optlen);
|
||||
/* 4 */
|
||||
EXTERN HINSTANCE TclWinGetTclInstance(void);
|
||||
/* 5 */
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* Slot 6 is reserved */
|
||||
/* Slot 7 is reserved */
|
||||
/* 6 */
|
||||
EXTERN unsigned short TclWinNToHS(unsigned short ns);
|
||||
/* 7 */
|
||||
EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname,
|
||||
const char *optval, int optlen);
|
||||
/* 8 */
|
||||
EXTERN int TclpGetPid(Tcl_Pid pid);
|
||||
/* Slot 9 is reserved */
|
||||
/* Slot 10 is reserved */
|
||||
/* 9 */
|
||||
EXTERN int TclWinGetPlatformId(void);
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN void TclGetAndDetachPids(Tcl_Interp *interp,
|
||||
Tcl_Channel chan);
|
||||
@@ -144,17 +153,20 @@ EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction);
|
||||
EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
/* 20 */
|
||||
EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id);
|
||||
/* Slot 21 is reserved */
|
||||
/* 21 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 22 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* Slot 23 is reserved */
|
||||
/* 24 */
|
||||
EXTERN char * TclWinNoBackslash(char *path);
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
/* 26 */
|
||||
EXTERN void TclWinSetInterfaces(int wide);
|
||||
/* 27 */
|
||||
EXTERN void TclWinFlushDirtyChannels(void);
|
||||
/* Slot 28 is reserved */
|
||||
/* 28 */
|
||||
EXTERN void TclWinResetInterfaces(void);
|
||||
/* 29 */
|
||||
EXTERN int TclWinCPUID(int index, int *regs);
|
||||
/* 30 */
|
||||
@@ -188,10 +200,14 @@ EXTERN TclFile TclpOpenFile(const char *fname, int mode);
|
||||
EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout);
|
||||
/* 9 */
|
||||
EXTERN TclFile TclpCreateTempFile(const char *contents);
|
||||
/* Slot 10 is reserved */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* Slot 13 is reserved */
|
||||
/* 10 */
|
||||
EXTERN Tcl_DirEntry * TclpReaddir(TclDIR *dir);
|
||||
/* 11 */
|
||||
EXTERN struct tm * TclpLocaltime_unix(const time_t *clock);
|
||||
/* 12 */
|
||||
EXTERN struct tm * TclpGmtime_unix(const time_t *clock);
|
||||
/* 13 */
|
||||
EXTERN char * TclpInetNtoa(struct in_addr addr);
|
||||
/* 14 */
|
||||
EXTERN int TclUnixCopyFile(const char *src, const char *dst,
|
||||
const Tcl_StatBuf *statBufPtr,
|
||||
@@ -248,10 +264,10 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
void (*reserved10)(void);
|
||||
void (*reserved11)(void);
|
||||
void (*reserved12)(void);
|
||||
void (*reserved13)(void);
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
void (*reserved15)(void);
|
||||
void (*reserved16)(void);
|
||||
@@ -272,16 +288,16 @@ typedef struct TclIntPlatStubs {
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
void (*tclWinConvertError) (DWORD errCode); /* 0 */
|
||||
void (*reserved1)(void);
|
||||
void (*reserved2)(void);
|
||||
void (*reserved3)(void);
|
||||
void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
|
||||
struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
|
||||
int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
|
||||
HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
|
||||
void (*reserved6)(void);
|
||||
void (*reserved7)(void);
|
||||
unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
|
||||
int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
|
||||
int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
|
||||
void (*reserved9)(void);
|
||||
void (*reserved10)(void);
|
||||
int (*tclWinGetPlatformId) (void); /* 9 */
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
|
||||
int (*tclpCloseFile) (TclFile file); /* 12 */
|
||||
Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
|
||||
@@ -292,14 +308,14 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
|
||||
void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
|
||||
void (*reserved21)(void);
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
|
||||
void (*reserved23)(void);
|
||||
char * (*tclWinNoBackslash) (char *path); /* 24 */
|
||||
void (*reserved25)(void);
|
||||
void (*reserved26)(void);
|
||||
void (*tclWinSetInterfaces) (int wide); /* 26 */
|
||||
void (*tclWinFlushDirtyChannels) (void); /* 27 */
|
||||
void (*reserved28)(void);
|
||||
void (*tclWinResetInterfaces) (void); /* 28 */
|
||||
int (*tclWinCPUID) (int index, int *regs); /* 29 */
|
||||
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
|
||||
#endif /* WIN */
|
||||
@@ -314,10 +330,10 @@ typedef struct TclIntPlatStubs {
|
||||
TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
|
||||
int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
|
||||
TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
|
||||
void (*reserved10)(void);
|
||||
void (*reserved11)(void);
|
||||
void (*reserved12)(void);
|
||||
void (*reserved13)(void);
|
||||
Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
|
||||
struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
|
||||
struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
|
||||
char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
|
||||
int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
|
||||
int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
|
||||
int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
|
||||
@@ -370,10 +386,14 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
/* Slot 10 is reserved */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* Slot 13 is reserved */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
|
||||
/* Slot 15 is reserved */
|
||||
@@ -398,19 +418,26 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
#define TclWinConvertError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
|
||||
/* Slot 1 is reserved */
|
||||
/* Slot 2 is reserved */
|
||||
/* Slot 3 is reserved */
|
||||
#define TclWinConvertWSAError \
|
||||
(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
|
||||
#define TclWinGetServByName \
|
||||
(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
|
||||
#define TclWinGetSockOpt \
|
||||
(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
|
||||
#define TclWinGetTclInstance \
|
||||
(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
|
||||
#define TclUnixWaitForFile \
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
|
||||
/* Slot 6 is reserved */
|
||||
/* Slot 7 is reserved */
|
||||
#define TclWinNToHS \
|
||||
(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
|
||||
#define TclWinSetSockOpt \
|
||||
(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
|
||||
#define TclpGetPid \
|
||||
(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
|
||||
/* Slot 9 is reserved */
|
||||
/* Slot 10 is reserved */
|
||||
#define TclWinGetPlatformId \
|
||||
(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclGetAndDetachPids \
|
||||
(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
|
||||
#define TclpCloseFile \
|
||||
@@ -431,17 +458,20 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
|
||||
#define TclWinAddProcess \
|
||||
(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
|
||||
/* Slot 21 is reserved */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
|
||||
/* Slot 23 is reserved */
|
||||
#define TclWinNoBackslash \
|
||||
(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
|
||||
/* Slot 25 is reserved */
|
||||
/* Slot 26 is reserved */
|
||||
#define TclWinSetInterfaces \
|
||||
(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
|
||||
#define TclWinFlushDirtyChannels \
|
||||
(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
|
||||
/* Slot 28 is reserved */
|
||||
#define TclWinResetInterfaces \
|
||||
(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
|
||||
#define TclWinCPUID \
|
||||
(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
|
||||
#define TclUnixOpenTemporaryFile \
|
||||
@@ -467,10 +497,14 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
|
||||
#define TclpCreateTempFile \
|
||||
(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
|
||||
/* Slot 10 is reserved */
|
||||
/* Slot 11 is reserved */
|
||||
/* Slot 12 is reserved */
|
||||
/* Slot 13 is reserved */
|
||||
#define TclpReaddir \
|
||||
(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
|
||||
#define TclpLocaltime_unix \
|
||||
(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
|
||||
#define TclpGmtime_unix \
|
||||
(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
|
||||
#define TclpInetNtoa \
|
||||
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
|
||||
#define TclUnixCopyFile \
|
||||
(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
|
||||
#define TclMacOSXGetFileAttribute \
|
||||
@@ -504,9 +538,31 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
|
||||
|
||||
#undef TCL_STORAGE_CLASS
|
||||
#define TCL_STORAGE_CLASS DLLIMPORT
|
||||
#undef TclpLocaltime_unix
|
||||
#undef TclpGmtime_unix
|
||||
#undef TclWinConvertWSAError
|
||||
#define TclWinConvertWSAError TclWinConvertError
|
||||
#undef TclpInetNtoa
|
||||
#define TclpInetNtoa inet_ntoa
|
||||
|
||||
#if !defined(_WIN32)
|
||||
#if defined(_WIN32)
|
||||
# undef TclWinNToHS
|
||||
# undef TclWinGetServByName
|
||||
# undef TclWinGetSockOpt
|
||||
# undef TclWinSetSockOpt
|
||||
# undef TclWinGetPlatformId
|
||||
# undef TclWinResetInterfaces
|
||||
# undef TclWinSetInterfaces
|
||||
# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
# define TclWinNToHS ntohs
|
||||
# define TclWinGetServByName getservbyname
|
||||
# define TclWinGetSockOpt getsockopt
|
||||
# define TclWinSetSockOpt setsockopt
|
||||
# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
|
||||
# define TclWinResetInterfaces() /* nop */
|
||||
# define TclWinSetInterfaces(dummy) /* nop */
|
||||
# endif /* TCL_NO_DEPRECATED */
|
||||
#else
|
||||
# undef TclpGetPid
|
||||
# define TclpGetPid(pid) ((unsigned long) (pid))
|
||||
#endif
|
||||
|
||||
+9
-9
@@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL;
|
||||
struct Target;
|
||||
|
||||
/*
|
||||
* Alias:
|
||||
* struct Alias:
|
||||
*
|
||||
* Stores information about an alias. Is stored in the slave interpreter and
|
||||
* used by the source command to find the target command in the master when
|
||||
* the source command is invoked.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct Alias {
|
||||
Tcl_Obj *token; /* Token for the alias command in the slave
|
||||
* interp. This used to be the command name in
|
||||
* the slave when the alias was first
|
||||
@@ -66,14 +66,14 @@ typedef struct {
|
||||
|
||||
/*
|
||||
*
|
||||
* Slave:
|
||||
* struct Slave:
|
||||
*
|
||||
* Used by the "interp" command to record and find information about slave
|
||||
* interpreters. Maps from a command name in the master to information about a
|
||||
* slave interpreter, e.g. what aliases are defined in it.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct Slave {
|
||||
Tcl_Interp *masterInterp; /* Master interpreter for this slave. */
|
||||
Tcl_HashEntry *slaveEntryPtr;
|
||||
/* Hash entry in masters slave table for this
|
||||
@@ -112,7 +112,7 @@ typedef struct Target {
|
||||
} Target;
|
||||
|
||||
/*
|
||||
* Master:
|
||||
* struct Master:
|
||||
*
|
||||
* This record is used for two purposes: First, slaveTable (a hashtable) maps
|
||||
* from names of commands to slave interpreters. This hashtable is used to
|
||||
@@ -127,7 +127,7 @@ typedef struct Target {
|
||||
* only load safe extensions.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct Master {
|
||||
Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps
|
||||
* from command names to Slave records. */
|
||||
Target *targetsPtr; /* The head of a doubly-linked list of all the
|
||||
@@ -144,7 +144,7 @@ typedef struct {
|
||||
* on a per-interp basis.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct InterpInfo {
|
||||
Master master; /* Keeps track of all interps for which this
|
||||
* interp is the Master. */
|
||||
Slave slave; /* Information necessary for this interp to
|
||||
@@ -158,7 +158,7 @@ typedef struct {
|
||||
* likely to work properly on 64-bit architectures.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ScriptLimitCallback {
|
||||
Tcl_Interp *interp; /* The interpreter in which to execute the
|
||||
* callback. */
|
||||
Tcl_Obj *scriptObj; /* The script to execute to perform the
|
||||
@@ -171,7 +171,7 @@ typedef struct {
|
||||
* table. */
|
||||
} ScriptLimitCallback;
|
||||
|
||||
typedef struct {
|
||||
typedef struct ScriptLimitCallbackKey {
|
||||
Tcl_Interp *interp; /* The interpreter that the limit callback was
|
||||
* attached to. This is not the interpreter
|
||||
* that the callback runs in! */
|
||||
|
||||
+1
-1
@@ -21,7 +21,7 @@
|
||||
* variable.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct Link {
|
||||
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
|
||||
Tcl_Obj *varName; /* Name of variable (must be global). This is
|
||||
* needed during trace callbacks, since the
|
||||
|
||||
+298
-275
@@ -55,22 +55,20 @@ const Tcl_ObjType tclListType = {
|
||||
*
|
||||
* NewListIntRep --
|
||||
*
|
||||
* Creates a 'List' structure with space for 'objc' elements. 'objc' must
|
||||
* be > 0. If 'objv' is not NULL, The list is initialized with first
|
||||
* 'objc' values in that array. Otherwise the list is initialized to have
|
||||
* 0 elements, with space to add 'objc' more. Flag value 'p' indicates
|
||||
* Creates a list internal rep with space for objc elements. objc
|
||||
* must be > 0. If objv!=NULL, initializes with the first objc values
|
||||
* in that array. If objv==NULL, initalize list internal rep to have
|
||||
* 0 elements, with space to add objc more. Flag value "p" indicates
|
||||
* how to behave on failure.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* A new List struct with refCount 0 is returned. If some failure
|
||||
* prevents this then if p=0, NULL is returned and otherwise the
|
||||
* routine panics.
|
||||
*
|
||||
* A new 'List' structure with refCount 0. If some failure
|
||||
* prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
|
||||
* is called if it is not.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The refCount of each value in 'objv' is incremented as it is added
|
||||
* to the list.
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -134,9 +132,21 @@ NewListIntRep(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* AttemptNewList --
|
||||
* AttemptNewList --
|
||||
*
|
||||
* Like NewListIntRep, but additionally sets an error message on failure.
|
||||
* Creates a list internal rep with space for objc elements. objc
|
||||
* must be > 0. If objv!=NULL, initializes with the first objc values
|
||||
* in that array. If objv==NULL, initalize list internal rep to have
|
||||
* 0 elements, with space to add objc more.
|
||||
*
|
||||
* Results:
|
||||
* A new List struct with refCount 0 is returned. If some failure
|
||||
* prevents this then NULL is returned, and an error message is left
|
||||
* in the interp result, unless interp is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -169,20 +179,23 @@ AttemptNewList(
|
||||
*
|
||||
* Tcl_NewListObj --
|
||||
*
|
||||
* Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
|
||||
* defined, 'Tcl_DbNewListObj' is called instead.
|
||||
* This function is normally called when not debugging: i.e., when
|
||||
* TCL_MEM_DEBUG is not defined. It creates a new list object from an
|
||||
* (objc,objv) array: that is, each of the objc elements of the array
|
||||
* referenced by objv is inserted as an element into a new Tcl object.
|
||||
*
|
||||
* Value
|
||||
* When TCL_MEM_DEBUG is defined, this function just returns the result
|
||||
* of calling the debugging version Tcl_DbNewListObj.
|
||||
*
|
||||
* A new list 'Tcl_Obj' to which is appended values from 'objv', or if
|
||||
* 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
|
||||
* elements. The string representation of the new 'Tcl_Obj' is set to
|
||||
* NULL. The refCount of the list is 0.
|
||||
* Results:
|
||||
* A new list object is returned that is initialized from the object
|
||||
* pointers in objv. If objc is less than or equal to zero, an empty
|
||||
* object is returned. The new object's string representation is left
|
||||
* NULL. The resulting new list object has ref count 0.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The refCount of each elements in 'objv' is incremented as it is added
|
||||
* to the list.
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -233,14 +246,28 @@ Tcl_NewListObj(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_DbNewListObj --
|
||||
* Tcl_DbNewListObj --
|
||||
*
|
||||
* Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
|
||||
* file name and line number from its caller. This simplifies debugging
|
||||
* since the [memory active] command will report the correct file
|
||||
* name and line number when reporting objects that haven't been freed.
|
||||
* This function is normally called when debugging: i.e., when
|
||||
* TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
|
||||
* as the Tcl_NewListObj function above except that it calls
|
||||
* Tcl_DbCkalloc directly with the file name and line number from its
|
||||
* caller. This simplifies debugging since then the [memory active]
|
||||
* command will report the correct file name and line number when
|
||||
* reporting objects that haven't been freed.
|
||||
*
|
||||
* When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
|
||||
* When TCL_MEM_DEBUG is not defined, this function just returns the
|
||||
* result of calling Tcl_NewListObj.
|
||||
*
|
||||
* Results:
|
||||
* A new list object is returned that is initialized from the object
|
||||
* pointers in objv. If objc is less than or equal to zero, an empty
|
||||
* object is returned. The new object's string representation is left
|
||||
* NULL. The new list object has ref count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* The ref counts of the elements in objv are incremented since the
|
||||
* resulting list now refers to them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -301,8 +328,19 @@ Tcl_DbNewListObj(
|
||||
*
|
||||
* Tcl_SetListObj --
|
||||
*
|
||||
* Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
|
||||
* creating a new one.
|
||||
* Modify an object to be a list containing each of the objc elements of
|
||||
* the object array referenced by objv.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object is made a list object and is initialized from the object
|
||||
* pointers in objv. If objc is less than or equal to zero, an empty
|
||||
* object is returned. The new object's string representation is left
|
||||
* NULL. The ref counts of the elements in objv are incremented since the
|
||||
* list now refers to them. The object's old string and internal
|
||||
* representations are freed and its type is set NULL.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -346,20 +384,18 @@ Tcl_SetListObj(
|
||||
*
|
||||
* TclListObjCopy --
|
||||
*
|
||||
* Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
|
||||
* provides for the C level a counterpart of the [lrange $list 0 end]
|
||||
* command, while using internals details to be as efficient as possible.
|
||||
* Makes a "pure list" copy of a list value. This provides for the C
|
||||
* level a counterpart of the [lrange $list 0 end] command, while using
|
||||
* internals details to be as efficient as possible.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* Normally returns a pointer to a new Tcl_Obj, that contains the same
|
||||
* list value as *listPtr does. The returned Tcl_Obj has a refCount of
|
||||
* zero. If *listPtr does not hold a list, NULL is returned, and if
|
||||
* interp is non-NULL, an error message is recorded there.
|
||||
*
|
||||
* The address of the new 'Tcl_Obj' which shares its internal
|
||||
* representation with 'listPtr', and whose refCount is 0. If 'listPtr'
|
||||
* is not actually a list, the value is NULL, and an error message is left
|
||||
* in 'interp' if it is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* 'listPtr' is converted to a list if it isn't one already.
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -470,30 +506,27 @@ TclListObjRange(
|
||||
*
|
||||
* Tcl_ListObjGetElements --
|
||||
*
|
||||
* Retreive the elements in a list 'Tcl_Obj'.
|
||||
* This function returns an (objc,objv) array of the elements in a list
|
||||
* object.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case *objcPtr is set to
|
||||
* the count of list elements and *objvPtr is set to a pointer to an
|
||||
* array of (*objcPtr) pointers to each list element. If listPtr does not
|
||||
* refer to a list object and the object can not be converted to one,
|
||||
* TCL_ERROR is returned and an error message will be left in the
|
||||
* interpreter's result if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
* The objects referenced by the returned array should be treated as
|
||||
* readonly and their ref counts are _not_ incremented; the caller must
|
||||
* do that if it holds on to a reference. Furthermore, the pointer and
|
||||
* length returned by this function may change as soon as any function is
|
||||
* called on the list object; be careful about retaining the pointer in a
|
||||
* local data structure.
|
||||
*
|
||||
* A count of list elements is stored, 'objcPtr', And a pointer to the
|
||||
* array of elements in the list is stored in 'objvPtr'.
|
||||
*
|
||||
* The elements accessible via 'objvPtr' should be treated as readonly
|
||||
* and the refCount for each object is _not_ incremented; the caller
|
||||
* must do that if it holds on to a reference. Furthermore, the
|
||||
* pointer and length returned by this function may change as soon as
|
||||
* any function is called on the list object. Be careful about
|
||||
* retaining the pointer in a local data structure.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* 'listPtr' is converted to a list object if it isn't one already.
|
||||
* Side effects:
|
||||
* The possible conversion of the object referenced by listPtr
|
||||
* to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -534,27 +567,20 @@ Tcl_ListObjGetElements(
|
||||
*
|
||||
* Tcl_ListObjAppendList --
|
||||
*
|
||||
* Appends the elements of elemListPtr to those of listPtr.
|
||||
* This function appends the elements in the list value referenced by
|
||||
* elemListPtr to the list value referenced by listPtr.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK. If listPtr or elemListPtr do not
|
||||
* refer to list values, TCL_ERROR is returned and an error message is
|
||||
* left in the interpreter's result if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* Success.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' or 'elemListPtr' are not valid lists. An error
|
||||
* message is left in the interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The reference count of each element of 'elemListPtr' as it is added to
|
||||
* 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
|
||||
* if they are not already. Appending the new elements may cause the
|
||||
* array of element pointers in 'listObj' to grow. If any objects are
|
||||
* appended to 'listPtr'. Any preexisting string representation of
|
||||
* 'listPtr' is invalidated.
|
||||
* Side effects:
|
||||
* The reference counts of the elements in elemListPtr are incremented
|
||||
* since the list now refers to them. listPtr and elemListPtr are
|
||||
* converted, if necessary, to list objects. Also, appending the new
|
||||
* elements may cause listObj's array of element pointers to grow.
|
||||
* listPtr's old string representation, if any, is invalidated.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -593,27 +619,24 @@ Tcl_ListObjAppendList(
|
||||
*
|
||||
* Tcl_ListObjAppendElement --
|
||||
*
|
||||
* Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
|
||||
* This function is a special purpose version of Tcl_ListObjAppendList:
|
||||
* it appends a single object referenced by objPtr to the list object
|
||||
* referenced by listPtr. If listPtr is not already a list object, an
|
||||
* attempt will be made to convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case objPtr is added to
|
||||
* the end of listPtr's list. If listPtr does not refer to a list object
|
||||
* and the object can not be converted to one, TCL_ERROR is returned and
|
||||
* an error message will be left in the interpreter's result if interp is
|
||||
* not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* 'objPtr' is appended to the elements of 'listPtr'.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* listPtr does not refer to a list object and the object can not be
|
||||
* converted to one. An error message will be left in the
|
||||
* interpreter's result if interp is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' is not already of type 'tclListType', it is converted.
|
||||
* The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
|
||||
* Appending the new element may cause the the array of element pointers
|
||||
* in 'listObj' to grow. Any preexisting string representation of
|
||||
* 'listPtr' is invalidated.
|
||||
* Side effects:
|
||||
* The ref count of objPtr is incremented since the list now refers to
|
||||
* it. listPtr will be converted, if necessary, to a list object. Also,
|
||||
* appending the new element may cause listObj's array of element
|
||||
* pointers to grow. listPtr's old string representation, if any, is
|
||||
* invalidated.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -764,27 +787,23 @@ Tcl_ListObjAppendElement(
|
||||
*
|
||||
* Tcl_ListObjIndex --
|
||||
*
|
||||
* Retrieve a pointer to the element of 'listPtr' at 'index'. The index
|
||||
* of the first element is 0.
|
||||
* This function returns a pointer to the index'th object from the list
|
||||
* referenced by listPtr. The first element has index 0. If index is
|
||||
* negative or greater than or equal to the number of elements in the
|
||||
* list, a NULL is returned. If listPtr is not a list object, an attempt
|
||||
* will be made to convert it to a list.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case objPtrPtr is set to
|
||||
* the Tcl_Obj pointer for the index'th list element or NULL if index is
|
||||
* out of range. This object should be treated as readonly and its ref
|
||||
* count is _not_ incremented; the caller must do that if it holds on to
|
||||
* the reference. If listPtr does not refer to a list and can't be
|
||||
* converted to one, TCL_ERROR is returned and an error message is left
|
||||
* in the interpreter's result if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* A pointer to the element at 'index' is stored in 'objPtrPtr'. If
|
||||
* 'index' is out of range, NULL is stored in 'objPtrPtr'. This
|
||||
* object should be treated as readonly and its 'refCount' is _not_
|
||||
* incremented. The caller must do that if it holds on to the
|
||||
* reference.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An an error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' is not already of type 'tclListType', it is converted.
|
||||
* Side effects:
|
||||
* listPtr will be converted, if necessary, to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -826,20 +845,19 @@ Tcl_ListObjIndex(
|
||||
*
|
||||
* Tcl_ListObjLength --
|
||||
*
|
||||
* Retrieve the number of elements in a list.
|
||||
* This function returns the number of elements in a list object. If the
|
||||
* object is not already a list object, an attempt will be made to
|
||||
* convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK; in this case *intPtr will be set
|
||||
* to the integer count of list elements. If listPtr does not refer to a
|
||||
* list object and the object can not be converted to one, TCL_ERROR is
|
||||
* returned and an error message will be left in the interpreter's result
|
||||
* if interp is not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* A count of list elements is stored at the address provided by
|
||||
* 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
|
||||
* converted.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An error message will be left in
|
||||
* the interpreter's result if 'interp' is not NULL.
|
||||
* Side effects:
|
||||
* The possible conversion of the argument object to a list object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -875,36 +893,35 @@ Tcl_ListObjLength(
|
||||
*
|
||||
* Tcl_ListObjReplace --
|
||||
*
|
||||
* Replace values in a list.
|
||||
* This function replaces zero or more elements of the list referenced by
|
||||
* listPtr with the objects from an (objc,objv) array. The objc elements
|
||||
* of the array referenced by objv replace the count elements in listPtr
|
||||
* starting at first.
|
||||
*
|
||||
* If 'first' is zero or negative, it refers to the first element. If
|
||||
* 'first' outside the range of elements in the list, no elements are
|
||||
* deleted.
|
||||
* If the argument first is zero or negative, it refers to the first
|
||||
* element. If first is greater than or equal to the number of elements
|
||||
* in the list, then no elements are deleted; the new elements are
|
||||
* appended to the list. Count gives the number of elements to replace.
|
||||
* If count is zero or negative then no elements are deleted; the new
|
||||
* elements are simply inserted before first.
|
||||
*
|
||||
* If 'count' is zero or negative no elements are deleted, and any new
|
||||
* elements are inserted at the beginning of the list.
|
||||
* The argument objv refers to an array of objc pointers to the new
|
||||
* elements to be added to listPtr in place of those that were deleted.
|
||||
* If objv is NULL, no new elements are added. If listPtr is not a list
|
||||
* object, an attempt will be made to convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* The return value is normally TCL_OK. If listPtr does not refer to a
|
||||
* list object and can not be converted to one, TCL_ERROR is returned and
|
||||
* an error message will be left in the interpreter's result if interp is
|
||||
* not NULL.
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
|
||||
* starting at 'first'. If 'objc' 0, no new elements are added.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' is not a valid list. An error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' is not of type 'tclListType', it is converted if possible.
|
||||
*
|
||||
* The 'refCount' of each element appended to the list is incremented.
|
||||
* Similarly, the 'refCount' for each replaced element is decremented.
|
||||
*
|
||||
* If 'listPtr' is modified, any previous string representation is
|
||||
* invalidated.
|
||||
* Side effects:
|
||||
* The ref counts of the objc elements in objv are incremented since the
|
||||
* resulting list now refers to them. Similarly, the ref counts for
|
||||
* replaced objects are decremented. listPtr is converted, if necessary,
|
||||
* to a list object. listPtr's old string representation, if any, is
|
||||
* freed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1065,7 +1082,11 @@ Tcl_ListObjReplace(
|
||||
if (listRepPtr == NULL) {
|
||||
for (i = 0; i < objc; i++) {
|
||||
/* See bug 3598580 */
|
||||
#if TCL_MAJOR_VERSION > 8
|
||||
Tcl_DecrRefCount(objv[i]);
|
||||
#else
|
||||
objv[i]->refCount--;
|
||||
#endif
|
||||
}
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -1158,19 +1179,22 @@ Tcl_ListObjReplace(
|
||||
*
|
||||
* TclLindexList --
|
||||
*
|
||||
* Implements the 'lindex' command when objc==3.
|
||||
* This procedure handles the 'lindex' command when objc==3.
|
||||
*
|
||||
* Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
|
||||
* the argument format into required form while taking care to manage
|
||||
* shimmering so as to tend to keep the most useful intreps
|
||||
* and/or avoid the most expensive conversions.
|
||||
* Results:
|
||||
* Returns a pointer to the object extracted, or NULL if an error
|
||||
* occurred. The returned object already includes one reference count for
|
||||
* the pointer returned.
|
||||
*
|
||||
* Value
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
* A pointer to the specified element, with its 'refCount' incremented, or
|
||||
* NULL if an error occurred.
|
||||
*
|
||||
* Notes
|
||||
* Notes:
|
||||
* This procedure is implemented entirely as a wrapper around
|
||||
* TclLindexFlat. All it does is reconfigure the argument format into the
|
||||
* form required by TclLindexFlat, while taking care to manage shimmering
|
||||
* in such a way that we tend to keep the most useful intreps and/or
|
||||
* avoid the most expensive conversions.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1236,20 +1260,25 @@ TclLindexList(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* TclLindexFlat --
|
||||
* TclLindexFlat --
|
||||
*
|
||||
* The core of the 'lindex' command, with all index
|
||||
* arguments presented as a flat list.
|
||||
* This procedure is the core of the 'lindex' command, with all index
|
||||
* arguments presented as a flat list.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* Returns a pointer to the object extracted, or NULL if an error
|
||||
* occurred. The returned object already includes one reference count for
|
||||
* the pointer returned.
|
||||
*
|
||||
* A pointer to the object extracted, with its 'refCount' incremented, or
|
||||
* NULL if an error occurred. Thus, the calling code will usually do
|
||||
* something like:
|
||||
*
|
||||
* Tcl_SetObjResult(interp, result);
|
||||
* Tcl_DecrRefCount(result);
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
* Notes:
|
||||
* The reference count of the returned object includes one reference
|
||||
* corresponding to the pointer returned. Thus, the calling code will
|
||||
* usually do something like:
|
||||
* Tcl_SetObjResult(interp, result);
|
||||
* Tcl_DecrRefCount(result);
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1325,16 +1354,23 @@ TclLindexFlat(
|
||||
*
|
||||
* TclLsetList --
|
||||
*
|
||||
* The core of [lset] when objc == 4. Objv[2] may be either a
|
||||
* Core of the 'lset' command when objc == 4. Objv[2] may be either a
|
||||
* scalar index or a list of indices.
|
||||
*
|
||||
* Implemented entirely as a wrapper around 'TclLindexFlat', as described
|
||||
* for 'TclLindexList'.
|
||||
* Results:
|
||||
* Returns the new value of the list variable, or NULL if there was an
|
||||
* error. The returned object includes one reference count for the
|
||||
* pointer returned.
|
||||
*
|
||||
* Value
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
* The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
|
||||
* there was an error.
|
||||
* Notes:
|
||||
* This procedure is implemented entirely as a wrapper around
|
||||
* TclLsetFlat. All it does is reconfigure the argument format into the
|
||||
* form required by TclLsetFlat, while taking care to manage shimmering
|
||||
* in such a way that we tend to keep the most useful intreps and/or
|
||||
* avoid the most expensive conversions.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1396,39 +1432,36 @@ TclLsetList(
|
||||
*
|
||||
* Core engine of the 'lset' command.
|
||||
*
|
||||
* Value
|
||||
* Results:
|
||||
* Returns the new value of the list variable, or NULL if an error
|
||||
* occurred. The returned object includes one reference count for the
|
||||
* pointer returned.
|
||||
*
|
||||
* The resulting list
|
||||
* Side effects:
|
||||
* On entry, the reference count of the variable value does not reflect
|
||||
* any references held on the stack. The first action of this function is
|
||||
* to determine whether the object is shared, and to duplicate it if it
|
||||
* is. The reference count of the duplicate is incremented. At this
|
||||
* point, the reference count will be 1 for either case, so that the
|
||||
* object will appear to be unshared.
|
||||
*
|
||||
* The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not
|
||||
* duplicated, its 'refCount' is incremented. The reference count of
|
||||
* an unduplicated object is therefore 2 (one for the returned pointer
|
||||
* and one for the variable that holds it). The reference count of a
|
||||
* duplicate object is 1, reflecting that result is the only active
|
||||
* reference. The caller is expected to store the result in the
|
||||
* variable and decrement its reference count. (INST_STORE_* does
|
||||
* exactly this.)
|
||||
* If an error occurs, and the object has been duplicated, the reference
|
||||
* count on the duplicate is decremented so that it is now 0: this
|
||||
* dismisses any memory that was allocated by this function.
|
||||
*
|
||||
* NULL
|
||||
* If no error occurs, the reference count of the original object is
|
||||
* incremented if the object has not been duplicated, and nothing is done
|
||||
* to a reference count of the duplicate. Now the reference count of an
|
||||
* unduplicated object is 2 (the returned pointer, plus the one stored in
|
||||
* the variable). The reference count of a duplicate object is 1,
|
||||
* reflecting that the returned pointer is the only active reference. The
|
||||
* caller is expected to store the returned value back in the variable
|
||||
* and decrement its reference count. (INST_STORE_* does exactly this.)
|
||||
*
|
||||
* An error occurred. If 'listPtr' was duplicated, the reference
|
||||
* count on the duplicate is decremented so that it is 0, causing any
|
||||
* memory allocated by this function to be freed.
|
||||
*
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* On entry, the reference count of 'listPtr' does not reflect any
|
||||
* references held on the stack. The first action of this function is to
|
||||
* determine whether 'listPtr' is shared and to create a duplicate
|
||||
* unshared copy if it is. The reference count of the duplicate is
|
||||
* incremented. At this point, the reference count is 1 in either case so
|
||||
* that the object is considered unshared.
|
||||
*
|
||||
* The unshared list is altered directly to produce the result.
|
||||
* 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
|
||||
* Surgery is performed on the unshared list value to produce the result.
|
||||
* TclLsetFlat maintains a linked list of Tcl_Obj's whose string
|
||||
* representations must be spoilt by threading via 'ptr2' of the
|
||||
* two-pointer internal representation. On entry to 'TclLsetFlat', the
|
||||
* two-pointer internal representation. On entry to TclLsetFlat, the
|
||||
* values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
|
||||
* Tcl_Obj that has been modified is set to NULL.
|
||||
*
|
||||
@@ -1643,38 +1676,26 @@ TclLsetFlat(
|
||||
*
|
||||
* TclListObjSetElement --
|
||||
*
|
||||
* Set a single element of a list to a specified value.
|
||||
* Set a single element of a list to a specified value
|
||||
*
|
||||
* Results:
|
||||
* The return value is normally TCL_OK. If listPtr does not refer to a
|
||||
* list object and cannot be converted to one, TCL_ERROR is returned and
|
||||
* an error message will be left in the interpreter result if interp is
|
||||
* not NULL. Similarly, if index designates an element outside the range
|
||||
* [0..listLength-1], where listLength is the count of elements in the
|
||||
* list object designated by listPtr, TCL_ERROR is returned and an error
|
||||
* message is left in the interpreter result.
|
||||
*
|
||||
* Side effects:
|
||||
* Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
|
||||
* to convert it to a list with a non-shared internal rep. Decrements the
|
||||
* ref count of the object at the specified index within the list,
|
||||
* replaces with the object designated by valuePtr, and increments the
|
||||
* ref count of the replacement object.
|
||||
*
|
||||
* It is the caller's responsibility to invalidate the string
|
||||
* representation of the 'listPtr'.
|
||||
*
|
||||
* Value
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* Success.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* 'listPtr' does not refer to a list object and cannot be converted
|
||||
* to one. An error message will be left in the interpreter result if
|
||||
* interp is not NULL.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* An index designates an element outside the range [0..listLength-1],
|
||||
* where 'listLength' is the count of elements in the list object
|
||||
* designated by 'listPtr'. An error message is left in the
|
||||
* interpreter result.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If
|
||||
* 'listPtr' is not already of type 'tclListType', it is converted and the
|
||||
* internal representation is unshared. The 'refCount' of the element at
|
||||
* 'index' is decremented and replaced in the list with the 'valuePtr',
|
||||
* whose 'refCount' in turn is incremented.
|
||||
*
|
||||
* representation of the object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1792,14 +1813,16 @@ TclListObjSetElement(
|
||||
*
|
||||
* FreeListInternalRep --
|
||||
*
|
||||
* Deallocate the storage associated with the internal representation of a
|
||||
* a list object.
|
||||
* Deallocate the storage associated with a list object's internal
|
||||
* representation.
|
||||
*
|
||||
* Effect
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* The storage for the internal 'List' pointer of 'listPtr' is freed, the
|
||||
* 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount'
|
||||
* of each element of the list is decremented.
|
||||
* Side effects:
|
||||
* Frees listPtr's List* internal representation and sets listPtr's
|
||||
* internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
|
||||
* element objects, which may free them.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1828,12 +1851,14 @@ FreeListInternalRep(
|
||||
*
|
||||
* DupListInternalRep --
|
||||
*
|
||||
* Initialize the internal representation of a list 'Tcl_Obj' to share the
|
||||
* Initialize the internal representation of a list Tcl_Obj to share the
|
||||
* internal representation of an existing list object.
|
||||
*
|
||||
* Effect
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* The 'refCount' of the List internal rep is incremented.
|
||||
* Side effects:
|
||||
* The reference count of the List internal rep is incremented.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1853,20 +1878,16 @@ DupListInternalRep(
|
||||
*
|
||||
* SetListFromAny --
|
||||
*
|
||||
* Convert any object to a list.
|
||||
* Attempt to generate a list internal form for the Tcl object "objPtr".
|
||||
*
|
||||
* Value
|
||||
*
|
||||
* TCL_OK
|
||||
*
|
||||
* Success. The internal representation of 'objPtr' is set, and the type
|
||||
* of 'objPtr' is 'tclListType'.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* An error occured during conversion. An error message is left in the
|
||||
* interpreter's result if 'interp' is not NULL.
|
||||
* Results:
|
||||
* The return value is TCL_OK or TCL_ERROR. If an error occurs during
|
||||
* conversion, an error message is left in the interpreter's result
|
||||
* unless "interp" is NULL.
|
||||
*
|
||||
* Side effects:
|
||||
* If no error occurs, a list is stored as "objPtr"s internal
|
||||
* representation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1991,16 +2012,18 @@ SetListFromAny(
|
||||
*
|
||||
* UpdateStringOfList --
|
||||
*
|
||||
* Update the string representation for a list object.
|
||||
* Update the string representation for a list object. Note: This
|
||||
* function does not invalidate an existing old string rep so storage
|
||||
* will be lost if this has not already been done.
|
||||
*
|
||||
* Any previously-exising string representation is not invalidated, so
|
||||
* storage is lost if this has not been taken care of.
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* The string representation of 'listPtr' is set to the resulting string.
|
||||
* This string will be empty if the list has no elements. It is assumed
|
||||
* that the list internal representation is not NULL.
|
||||
* Side effects:
|
||||
* The object's string is set to a valid string that results from the
|
||||
* list-to-string conversion. This string will be empty if the list has
|
||||
* no elements. The list internal representation should not be NULL and
|
||||
* we assume it is not NULL.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
+6
-4
@@ -470,17 +470,19 @@ Tcl_LoadObjCmd(
|
||||
*/
|
||||
|
||||
if (code != TCL_OK) {
|
||||
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
|
||||
Interp *iPtr = (Interp *) target;
|
||||
if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) {
|
||||
if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) {
|
||||
/*
|
||||
* A call to Tcl_InitStubs() determined the caller extension and
|
||||
* this interp are incompatible in their stubs mechanisms, and
|
||||
* recorded the error in the oldest legacy place we have to do so.
|
||||
*/
|
||||
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
|
||||
iPtr->legacyResult = NULL;
|
||||
iPtr->legacyFreeProc = (void (*) (void))-1;
|
||||
Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1));
|
||||
iPtr->result = &tclEmptyString;
|
||||
iPtr->freeProc = NULL;
|
||||
}
|
||||
#endif /* defined(TCL_NO_DEPRECATED) */
|
||||
Tcl_TransferResult(target, code, interp);
|
||||
goto done;
|
||||
}
|
||||
|
||||
+2
-2
@@ -32,7 +32,7 @@
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
size_t numNsCreated; /* Count of the number of namespaces created
|
||||
unsigned long numNsCreated; /* Count of the number of namespaces created
|
||||
* within the thread. This value is used as a
|
||||
* unique id for each namespace. Cannot be
|
||||
* per-interp because the nsId is used to
|
||||
@@ -52,7 +52,7 @@ static Tcl_ThreadDataKey dataKey;
|
||||
* with some information that is used to check the cached pointer's validity.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ResolvedNsName {
|
||||
Namespace *nsPtr; /* A cached pointer to the Namespace that the
|
||||
* name resolved to. */
|
||||
Namespace *refNsPtr; /* Points to the namespace context in which
|
||||
|
||||
+67
-8
@@ -31,6 +31,7 @@ static const struct {
|
||||
{"export", TclOODefineExportObjCmd, 0},
|
||||
{"forward", TclOODefineForwardObjCmd, 0},
|
||||
{"method", TclOODefineMethodObjCmd, 0},
|
||||
{"private", TclOODefinePrivateObjCmd, 0},
|
||||
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
|
||||
{"self", TclOODefineSelfObjCmd, 0},
|
||||
{"unexport", TclOODefineUnexportObjCmd, 0},
|
||||
@@ -41,6 +42,7 @@ static const struct {
|
||||
{"export", TclOODefineExportObjCmd, 1},
|
||||
{"forward", TclOODefineForwardObjCmd, 1},
|
||||
{"method", TclOODefineMethodObjCmd, 1},
|
||||
{"private", TclOODefinePrivateObjCmd, 1},
|
||||
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
|
||||
{"self", TclOODefineObjSelfObjCmd, 0},
|
||||
{"unexport", TclOODefineUnexportObjCmd, 1},
|
||||
@@ -993,6 +995,7 @@ ReleaseClassContents(
|
||||
Method *mPtr;
|
||||
Foundation *fPtr = oPtr->fPtr;
|
||||
Tcl_Obj *variableObj;
|
||||
PrivateVariableMapping *privateVariable;
|
||||
|
||||
/*
|
||||
* Sanity check!
|
||||
@@ -1099,6 +1102,14 @@ ReleaseClassContents(
|
||||
ckfree(clsPtr->variables.list);
|
||||
}
|
||||
|
||||
FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
|
||||
TclDecrRefCount(privateVariable->variableObj);
|
||||
TclDecrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
if (i) {
|
||||
ckfree(clsPtr->privateVariables.list);
|
||||
}
|
||||
|
||||
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
|
||||
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
|
||||
}
|
||||
@@ -1128,6 +1139,7 @@ ObjectNamespaceDeleted(
|
||||
Class *mixinPtr;
|
||||
Method *mPtr;
|
||||
Tcl_Obj *filterObj, *variableObj;
|
||||
PrivateVariableMapping *privateVariable;
|
||||
Tcl_Interp *interp = oPtr->fPtr->interp;
|
||||
int i;
|
||||
|
||||
@@ -1162,7 +1174,7 @@ ObjectNamespaceDeleted(
|
||||
|
||||
if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
|
||||
CallContext *contextPtr =
|
||||
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
|
||||
TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
|
||||
int result;
|
||||
|
||||
Tcl_InterpState state;
|
||||
@@ -1248,6 +1260,14 @@ ObjectNamespaceDeleted(
|
||||
ckfree(oPtr->variables.list);
|
||||
}
|
||||
|
||||
FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
|
||||
TclDecrRefCount(privateVariable->variableObj);
|
||||
TclDecrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
if (i) {
|
||||
ckfree(oPtr->privateVariables.list);
|
||||
}
|
||||
|
||||
if (oPtr->chainCache) {
|
||||
TclOODeleteChainCache(oPtr->chainCache);
|
||||
}
|
||||
@@ -1631,7 +1651,7 @@ Tcl_NewObjectInstance(
|
||||
|
||||
if (objc >= 0) {
|
||||
CallContext *contextPtr =
|
||||
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
|
||||
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
|
||||
|
||||
if (contextPtr != NULL) {
|
||||
int isRoot, result;
|
||||
@@ -1704,7 +1724,7 @@ TclNRNewObjectInstance(
|
||||
*objectPtr = (Tcl_Object) oPtr;
|
||||
return TCL_OK;
|
||||
}
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
|
||||
if (contextPtr == NULL) {
|
||||
*objectPtr = (Tcl_Object) oPtr;
|
||||
return TCL_OK;
|
||||
@@ -1884,6 +1904,7 @@ Tcl_CopyObjectInstance(
|
||||
Class *mixinPtr;
|
||||
CallContext *contextPtr;
|
||||
Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
|
||||
PrivateVariableMapping *privateVariable;
|
||||
int i, result;
|
||||
|
||||
/*
|
||||
@@ -1953,7 +1974,7 @@ Tcl_CopyObjectInstance(
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the object's variable resolution list to the new object.
|
||||
* Copy the object's variable resolution lists to the new object.
|
||||
*/
|
||||
|
||||
DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
|
||||
@@ -1961,6 +1982,13 @@ Tcl_CopyObjectInstance(
|
||||
Tcl_IncrRefCount(variableObj);
|
||||
}
|
||||
|
||||
DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
|
||||
PrivateVariableMapping);
|
||||
FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
|
||||
Tcl_IncrRefCount(privateVariable->variableObj);
|
||||
Tcl_IncrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the object's flags to the new object, clearing those that must be
|
||||
* kept object-local. The duplicate is never deleted at this point, nor is
|
||||
@@ -2049,7 +2077,7 @@ Tcl_CopyObjectInstance(
|
||||
}
|
||||
|
||||
/*
|
||||
* Copy the source class's variable resolution list.
|
||||
* Copy the source class's variable resolution lists.
|
||||
*/
|
||||
|
||||
DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
|
||||
@@ -2057,6 +2085,13 @@ Tcl_CopyObjectInstance(
|
||||
Tcl_IncrRefCount(variableObj);
|
||||
}
|
||||
|
||||
DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
|
||||
PrivateVariableMapping);
|
||||
FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
|
||||
Tcl_IncrRefCount(privateVariable->variableObj);
|
||||
Tcl_IncrRefCount(privateVariable->fullNameObj);
|
||||
}
|
||||
|
||||
/*
|
||||
* Duplicate the source class's mixins (which cannot be circular
|
||||
* references to the duplicate).
|
||||
@@ -2129,7 +2164,8 @@ Tcl_CopyObjectInstance(
|
||||
}
|
||||
|
||||
TclResetRewriteEnsemble(interp, 1);
|
||||
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
|
||||
contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
|
||||
NULL, NULL);
|
||||
if (contextPtr) {
|
||||
args[0] = TclOOObjectName(interp, o2Ptr);
|
||||
args[1] = oPtr->fPtr->clonedName;
|
||||
@@ -2526,6 +2562,9 @@ TclOOObjectCmdCore(
|
||||
{
|
||||
CallContext *contextPtr;
|
||||
Tcl_Obj *methodNamePtr;
|
||||
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
|
||||
Object *callerObjPtr = NULL;
|
||||
Class *callerClsPtr = NULL;
|
||||
int result;
|
||||
|
||||
/*
|
||||
@@ -2539,6 +2578,24 @@ TclOOObjectCmdCore(
|
||||
goto noMapping;
|
||||
}
|
||||
|
||||
/*
|
||||
* Determine if we're in a context that can see the extra, private methods
|
||||
* in this class.
|
||||
*/
|
||||
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
|
||||
CallContext *callerContextPtr = framePtr->clientData;
|
||||
Method *callerMethodPtr =
|
||||
callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;
|
||||
|
||||
if (callerMethodPtr->declaringObjectPtr) {
|
||||
callerObjPtr = callerMethodPtr->declaringObjectPtr;
|
||||
}
|
||||
if (callerMethodPtr->declaringClassPtr) {
|
||||
callerClsPtr = callerMethodPtr->declaringClassPtr;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Give plugged in code a chance to remap the method name.
|
||||
*/
|
||||
@@ -2566,7 +2623,8 @@ TclOOObjectCmdCore(
|
||||
|
||||
Tcl_IncrRefCount(mappedMethodName);
|
||||
contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
|
||||
flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
|
||||
flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
|
||||
callerClsPtr, methodNamePtr);
|
||||
TclDecrRefCount(mappedMethodName);
|
||||
if (contextPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
@@ -2583,7 +2641,8 @@ TclOOObjectCmdCore(
|
||||
|
||||
noMapping:
|
||||
contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
|
||||
flags | (oPtr->flags & FILTER_HANDLING), NULL);
|
||||
flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
|
||||
callerClsPtr, NULL);
|
||||
if (contextPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"impossible to invoke method \"%s\": no defined method or"
|
||||
|
||||
+5
-2
@@ -58,12 +58,12 @@ declare 10 {
|
||||
}
|
||||
declare 11 {
|
||||
Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
|
||||
Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
|
||||
Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData)
|
||||
}
|
||||
declare 12 {
|
||||
Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
|
||||
Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
|
||||
Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData)
|
||||
}
|
||||
declare 13 {
|
||||
@@ -126,6 +126,9 @@ declare 27 {
|
||||
declare 28 {
|
||||
Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
|
||||
}
|
||||
declare 29 {
|
||||
int Tcl_MethodIsPrivate(Tcl_Method method)
|
||||
}
|
||||
|
||||
######################################################################
|
||||
# Private API, exposed to support advanced OO systems that plug in on top of
|
||||
|
||||
+11
-2
@@ -95,10 +95,19 @@ typedef struct {
|
||||
/*
|
||||
* The correct value for the version field of the Tcl_MethodType structure.
|
||||
* This allows new versions of the structure to be introduced without breaking
|
||||
* binary compatibility.
|
||||
* binary compatability.
|
||||
*/
|
||||
|
||||
#define TCL_OO_METHOD_VERSION_CURRENT 1
|
||||
|
||||
/*
|
||||
* Visibility constants for the flags parameter to Tcl_NewMethod and
|
||||
* Tcl_NewInstanceMethod.
|
||||
*/
|
||||
|
||||
#define TCL_OO_METHOD_PUBLIC 1
|
||||
#define TCL_OO_METHOD_UNEXPORTED 0
|
||||
#define TCL_OO_METHOD_PRIVATE 0x20
|
||||
|
||||
/*
|
||||
* The type of some object (or class) metadata. This describes how to delete
|
||||
@@ -122,7 +131,7 @@ typedef struct {
|
||||
/*
|
||||
* The correct value for the version field of the Tcl_ObjectMetadataType
|
||||
* structure. This allows new versions of the structure to be introduced
|
||||
* without breaking binary compatibility.
|
||||
* without breaking binary compatability.
|
||||
*/
|
||||
|
||||
#define TCL_OO_METADATA_VERSION_CURRENT 1
|
||||
|
||||
+84
-16
@@ -347,7 +347,8 @@ TclOO_Object_Destroy(
|
||||
}
|
||||
if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
|
||||
oPtr->flags |= DESTRUCTOR_CALLED;
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
|
||||
contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
|
||||
NULL);
|
||||
if (contextPtr != NULL) {
|
||||
contextPtr->callPtr->flags |= DESTRUCTOR;
|
||||
contextPtr->skip = 0;
|
||||
@@ -499,9 +500,12 @@ TclOO_Object_Unknown(
|
||||
Tcl_Obj *const *objv) /* The actual arguments. */
|
||||
{
|
||||
CallContext *contextPtr = (CallContext *) context;
|
||||
Object *callerObj = NULL;
|
||||
Class *callerCls = NULL;
|
||||
Object *oPtr = contextPtr->oPtr;
|
||||
const char **methodNames;
|
||||
int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
|
||||
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
|
||||
Tcl_Obj *errorMsg;
|
||||
|
||||
/*
|
||||
@@ -515,11 +519,32 @@ TclOO_Object_Unknown(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
/*
|
||||
* Determine if the calling context should know about extra private
|
||||
* methods, and if so, which.
|
||||
*/
|
||||
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
|
||||
CallContext *callerContext = framePtr->clientData;
|
||||
Method *mPtr = callerContext->callPtr->chain[
|
||||
callerContext->index].mPtr;
|
||||
|
||||
if (mPtr->declaringObjectPtr) {
|
||||
if (oPtr == mPtr->declaringObjectPtr) {
|
||||
callerObj = mPtr->declaringObjectPtr;
|
||||
}
|
||||
} else {
|
||||
if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
|
||||
callerCls = mPtr->declaringClassPtr;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Get the list of methods that we want to know about.
|
||||
*/
|
||||
|
||||
numMethodNames = TclOOGetSortedMethodList(oPtr,
|
||||
numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
|
||||
contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
|
||||
|
||||
/*
|
||||
@@ -684,6 +709,7 @@ TclOO_Object_VarName(
|
||||
{
|
||||
Var *varPtr, *aryVar;
|
||||
Tcl_Obj *varNamePtr, *argPtr;
|
||||
CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
|
||||
const char *arg;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
|
||||
@@ -709,6 +735,58 @@ TclOO_Object_VarName(
|
||||
Tcl_Namespace *namespacePtr =
|
||||
Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
|
||||
|
||||
/*
|
||||
* Private method handling. [TIP 500]
|
||||
*
|
||||
* If we're in a context that can see some private methods of an
|
||||
* object, we may need to precede a variable name with its prefix.
|
||||
* This is a little tricky as we need to check through the inheritance
|
||||
* hierarchy when the method was declared by a class to see if the
|
||||
* current object is an instance of that class.
|
||||
*/
|
||||
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
|
||||
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
|
||||
CallContext *callerContext = framePtr->clientData;
|
||||
Method *mPtr = callerContext->callPtr->chain[
|
||||
callerContext->index].mPtr;
|
||||
PrivateVariableMapping *pvPtr;
|
||||
int i;
|
||||
|
||||
if (mPtr->declaringObjectPtr == oPtr) {
|
||||
FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
|
||||
if (!strcmp(Tcl_GetString(pvPtr->variableObj),
|
||||
Tcl_GetString(argPtr))) {
|
||||
argPtr = pvPtr->fullNameObj;
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (mPtr->declaringClassPtr &&
|
||||
mPtr->declaringClassPtr->privateVariables.num) {
|
||||
Class *clsPtr = mPtr->declaringClassPtr;
|
||||
int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls);
|
||||
Class *mixinCls;
|
||||
|
||||
if (!isInstance) {
|
||||
FOREACH(mixinCls, oPtr->mixins) {
|
||||
if (TclOOIsReachable(clsPtr, mixinCls)) {
|
||||
isInstance = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (isInstance) {
|
||||
FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) {
|
||||
if (!strcmp(Tcl_GetString(pvPtr->variableObj),
|
||||
Tcl_GetString(argPtr))) {
|
||||
argPtr = pvPtr->fullNameObj;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
|
||||
Tcl_AppendToObj(varNamePtr, "::", 2);
|
||||
Tcl_AppendObjToObj(varNamePtr, argPtr);
|
||||
@@ -729,26 +807,16 @@ TclOO_Object_VarName(
|
||||
|
||||
varNamePtr = Tcl_NewObj();
|
||||
if (aryVar != NULL) {
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch search;
|
||||
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
|
||||
|
||||
/*
|
||||
* WARNING! This code pokes inside the implementation of hash tables!
|
||||
*/
|
||||
|
||||
hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
|
||||
&search);
|
||||
while (hPtr != NULL) {
|
||||
if (varPtr == Tcl_GetHashValue(hPtr)) {
|
||||
Tcl_AppendToObj(varNamePtr, "(", -1);
|
||||
Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
|
||||
Tcl_AppendToObj(varNamePtr, ")", -1);
|
||||
break;
|
||||
}
|
||||
hPtr = Tcl_NextHashEntry(&search);
|
||||
}
|
||||
Tcl_AppendToObj(varNamePtr, "(", -1);
|
||||
Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
|
||||
varPtr)->entry.key.objPtr);
|
||||
Tcl_AppendToObj(varNamePtr, ")", -1);
|
||||
} else {
|
||||
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
|
||||
}
|
||||
|
||||
+470
-212
File diff suppressed because it is too large
Load Diff
@@ -59,11 +59,11 @@ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
|
||||
/* 11 */
|
||||
TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
|
||||
Tcl_Object object, Tcl_Obj *nameObj,
|
||||
int isPublic, const Tcl_MethodType *typePtr,
|
||||
int flags, const Tcl_MethodType *typePtr,
|
||||
ClientData clientData);
|
||||
/* 12 */
|
||||
TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
|
||||
Tcl_Obj *nameObj, int isPublic,
|
||||
Tcl_Obj *nameObj, int flags,
|
||||
const Tcl_MethodType *typePtr,
|
||||
ClientData clientData);
|
||||
/* 13 */
|
||||
@@ -116,6 +116,8 @@ TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
|
||||
/* 28 */
|
||||
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
|
||||
Tcl_Object object);
|
||||
/* 29 */
|
||||
TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method);
|
||||
|
||||
typedef struct {
|
||||
const struct TclOOIntStubs *tclOOIntStubs;
|
||||
@@ -136,8 +138,8 @@ typedef struct TclOOStubs {
|
||||
int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
|
||||
int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
|
||||
Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
|
||||
Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
|
||||
Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
|
||||
Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
|
||||
Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
|
||||
Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
|
||||
int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
|
||||
int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
|
||||
@@ -154,6 +156,7 @@ typedef struct TclOOStubs {
|
||||
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
|
||||
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
|
||||
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
|
||||
int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
|
||||
} TclOOStubs;
|
||||
|
||||
extern const TclOOStubs *tclOOStubsPtr;
|
||||
@@ -226,6 +229,8 @@ extern const TclOOStubs *tclOOStubsPtr;
|
||||
(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
|
||||
#define Tcl_GetObjectName \
|
||||
(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
|
||||
#define Tcl_MethodIsPrivate \
|
||||
(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */
|
||||
|
||||
#endif /* defined(USE_TCLOO_STUBS) */
|
||||
|
||||
|
||||
+284
-100
@@ -16,6 +16,12 @@
|
||||
#include "tclInt.h"
|
||||
#include "tclOOInt.h"
|
||||
|
||||
/*
|
||||
* The actual value used to mark private declaration frames.
|
||||
*/
|
||||
|
||||
#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)
|
||||
|
||||
/*
|
||||
* The maximum length of fully-qualified object name to use in an errorinfo
|
||||
* message. Longer than this will be curtailed.
|
||||
@@ -118,6 +124,35 @@ static const struct DeclaredSlot slots[] = {
|
||||
SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet),
|
||||
{NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
|
||||
};
|
||||
|
||||
/*
|
||||
* How to build the in-namespace name of a private variable. This is a pattern
|
||||
* used with Tcl_ObjPrintf().
|
||||
*/
|
||||
|
||||
#define PRIVATE_VARIABLE_PATTERN "%d : %s"
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* IsPrivateDefine --
|
||||
*
|
||||
* Extracts whether the current context is handling private definitions.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static inline int
|
||||
IsPrivateDefine(
|
||||
Tcl_Interp *interp)
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
if (!iPtr->varFramePtr) {
|
||||
return 0;
|
||||
}
|
||||
return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
@@ -416,6 +451,123 @@ TclOOClassSetMixins(
|
||||
BumpGlobalEpoch(interp, classPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* InstallStandardVariableMapping, InstallPrivateVariableMapping --
|
||||
*
|
||||
* Helpers for installing standard and private variable maps.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
static inline void
|
||||
InstallStandardVariableMapping(
|
||||
VariableNameList *vnlPtr,
|
||||
int varc,
|
||||
Tcl_Obj *const *varv)
|
||||
{
|
||||
Tcl_Obj *variableObj;
|
||||
int i, n, created;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
FOREACH(variableObj, *vnlPtr) {
|
||||
Tcl_DecrRefCount(variableObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(vnlPtr->list);
|
||||
} else if (i) {
|
||||
vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
|
||||
} else {
|
||||
vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
|
||||
}
|
||||
}
|
||||
vnlPtr->num = 0;
|
||||
if (varc > 0) {
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
vnlPtr->list[n++] = varv[i];
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
vnlPtr->num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
if (n != varc) {
|
||||
vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
|
||||
}
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
}
|
||||
}
|
||||
|
||||
static inline void
|
||||
InstallPrivateVariableMapping(
|
||||
PrivateVariableList *pvlPtr,
|
||||
int varc,
|
||||
Tcl_Obj *const *varv,
|
||||
int creationEpoch)
|
||||
{
|
||||
PrivateVariableMapping *privatePtr;
|
||||
int i, n, created;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
FOREACH_STRUCT(privatePtr, *pvlPtr) {
|
||||
Tcl_DecrRefCount(privatePtr->variableObj);
|
||||
Tcl_DecrRefCount(privatePtr->fullNameObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(pvlPtr->list);
|
||||
} else if (i) {
|
||||
pvlPtr->list = ckrealloc(pvlPtr->list,
|
||||
sizeof(PrivateVariableMapping) * varc);
|
||||
} else {
|
||||
pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
|
||||
}
|
||||
}
|
||||
|
||||
pvlPtr->num = 0;
|
||||
if (varc > 0) {
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
privatePtr = &(pvlPtr->list[n++]);
|
||||
privatePtr->variableObj = varv[i];
|
||||
privatePtr->fullNameObj = Tcl_ObjPrintf(
|
||||
PRIVATE_VARIABLE_PATTERN,
|
||||
creationEpoch, Tcl_GetString(varv[i]));
|
||||
Tcl_IncrRefCount(privatePtr->fullNameObj);
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
pvlPtr->num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
if (n != varc) {
|
||||
pvlPtr->list = ckrealloc(pvlPtr->list,
|
||||
sizeof(PrivateVariableMapping) * n);
|
||||
}
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -708,7 +860,8 @@ TclOOGetDefineCmdContext(
|
||||
Tcl_Object object;
|
||||
|
||||
if ((iPtr->varFramePtr == NULL)
|
||||
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
|
||||
|| (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
|
||||
&& iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"this command may only be called from within the context of"
|
||||
" an ::oo::define or ::oo::objdefine command", -1));
|
||||
@@ -749,7 +902,8 @@ GetClassInOuterContext(
|
||||
Object *oPtr;
|
||||
CallFrame *savedFramePtr = iPtr->varFramePtr;
|
||||
|
||||
while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
|
||||
while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
|
||||
|| iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
|
||||
if (iPtr->varFramePtr->callerVarPtr == NULL) {
|
||||
Tcl_Panic("getting outer context when already in global context");
|
||||
}
|
||||
@@ -1038,7 +1192,7 @@ TclOODefineSelfObjCmd(
|
||||
{
|
||||
Foundation *fPtr = TclOOGetFoundation(interp);
|
||||
Object *oPtr;
|
||||
int result;
|
||||
int result, private;
|
||||
|
||||
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
if (oPtr == NULL) {
|
||||
@@ -1050,6 +1204,8 @@ TclOODefineSelfObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
private = IsPrivateDefine(interp);
|
||||
|
||||
/*
|
||||
* Make the oo::objdefine namespace the current namespace and evaluate the
|
||||
* command(s).
|
||||
@@ -1058,6 +1214,9 @@ TclOODefineSelfObjCmd(
|
||||
if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (private) {
|
||||
((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
|
||||
}
|
||||
|
||||
AddRef(oPtr);
|
||||
if (objc == 2) {
|
||||
@@ -1065,7 +1224,7 @@ TclOODefineSelfObjCmd(
|
||||
|
||||
Tcl_IncrRefCount(objNameObj);
|
||||
result = TclEvalObjEx(interp, objv[1], 0,
|
||||
((Interp *)interp)->cmdFramePtr, 2);
|
||||
((Interp *)interp)->cmdFramePtr, 1);
|
||||
if (result == TCL_ERROR) {
|
||||
GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
|
||||
}
|
||||
@@ -1117,6 +1276,79 @@ TclOODefineObjSelfObjCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* TclOODefinePrivateObjCmd --
|
||||
*
|
||||
* Implementation of the "private" subcommand of the "oo::define"
|
||||
* and "oo::objdefine" commands.
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int
|
||||
TclOODefinePrivateObjCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
int isInstancePrivate = (clientData != NULL);
|
||||
/* Just so that we can generate the correct
|
||||
* error message depending on the context of
|
||||
* usage of this function. */
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
int saved; /* The saved flag. We restore it on exit so
|
||||
* that [private private ...] doesn't make
|
||||
* things go weird. */
|
||||
int result;
|
||||
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 1) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Change the frame type flag while evaluating the body.
|
||||
*/
|
||||
|
||||
saved = iPtr->varFramePtr->isProcCallFrame;
|
||||
iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
|
||||
|
||||
/*
|
||||
* Evaluate the body; standard pattern.
|
||||
*/
|
||||
|
||||
AddRef(oPtr);
|
||||
if (objc == 2) {
|
||||
Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
|
||||
|
||||
Tcl_IncrRefCount(objNameObj);
|
||||
result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
|
||||
if (result == TCL_ERROR) {
|
||||
GenerateErrorInfo(interp, oPtr, objNameObj,
|
||||
isInstancePrivate ? "object" : "class");
|
||||
}
|
||||
TclDecrRefCount(objNameObj);
|
||||
} else {
|
||||
result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
|
||||
1, objc, objv);
|
||||
}
|
||||
TclOODecrRefCount(oPtr);
|
||||
|
||||
/*
|
||||
* Restore the frame type flag to what it was previously.
|
||||
*/
|
||||
|
||||
iPtr->varFramePtr->isProcCallFrame = saved;
|
||||
return result;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1460,8 +1692,9 @@ TclOODefineExportObjCmd(
|
||||
} else {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
}
|
||||
if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
|
||||
if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
|
||||
mPtr->flags |= PUBLIC_METHOD;
|
||||
mPtr->flags &= ~TRUE_PRIVATE_METHOD;
|
||||
changed = 1;
|
||||
}
|
||||
}
|
||||
@@ -1521,6 +1754,9 @@ TclOODefineForwardObjCmd(
|
||||
}
|
||||
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
|
||||
? PUBLIC_METHOD : 0;
|
||||
if (IsPrivateDefine(interp)) {
|
||||
isPublic = TRUE_PRIVATE_METHOD;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the method structure.
|
||||
@@ -1580,6 +1816,9 @@ TclOODefineMethodObjCmd(
|
||||
}
|
||||
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
|
||||
? PUBLIC_METHOD : 0;
|
||||
if (IsPrivateDefine(interp)) {
|
||||
isPublic = TRUE_PRIVATE_METHOD;
|
||||
}
|
||||
|
||||
/*
|
||||
* Create the method by using the right back-end API.
|
||||
@@ -1795,8 +2034,8 @@ TclOODefineUnexportObjCmd(
|
||||
} else {
|
||||
mPtr = Tcl_GetHashValue(hPtr);
|
||||
}
|
||||
if (isNew || mPtr->flags & PUBLIC_METHOD) {
|
||||
mPtr->flags &= ~PUBLIC_METHOD;
|
||||
if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
|
||||
mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
|
||||
changed = 1;
|
||||
}
|
||||
}
|
||||
@@ -2288,7 +2527,7 @@ ClassVarsGet(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Tcl_Obj *resultObj, *variableObj;
|
||||
Tcl_Obj *resultObj;
|
||||
int i;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
||||
@@ -2306,8 +2545,18 @@ ClassVarsGet(
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
FOREACH(variableObj, oPtr->classPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
if (IsPrivateDefine(interp)) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, oPtr->classPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -2323,7 +2572,7 @@ ClassVarsSet(
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
int varc;
|
||||
Tcl_Obj **varv, *variableObj;
|
||||
Tcl_Obj **varv;
|
||||
int i;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
|
||||
@@ -2364,49 +2613,11 @@ ClassVarsSet(
|
||||
}
|
||||
}
|
||||
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
FOREACH(variableObj, oPtr->classPtr->variables) {
|
||||
Tcl_DecrRefCount(variableObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(oPtr->classPtr->variables.list);
|
||||
} else if (i) {
|
||||
oPtr->classPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->classPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * varc);
|
||||
} else {
|
||||
oPtr->classPtr->variables.list = (Tcl_Obj **)
|
||||
ckalloc(sizeof(Tcl_Obj *) * varc);
|
||||
}
|
||||
}
|
||||
|
||||
oPtr->classPtr->variables.num = 0;
|
||||
if (varc > 0) {
|
||||
int created, n;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
oPtr->classPtr->variables.list[n++] = varv[i];
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
oPtr->classPtr->variables.num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
oPtr->classPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->classPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * n);
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
if (IsPrivateDefine(interp)) {
|
||||
InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,
|
||||
varc, varv, oPtr->classPtr->thisPtr->creationEpoch);
|
||||
} else {
|
||||
InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
@@ -2585,7 +2796,7 @@ ObjVarsGet(
|
||||
Tcl_Obj *const *objv)
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
Tcl_Obj *resultObj, *variableObj;
|
||||
Tcl_Obj *resultObj;
|
||||
int i;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
|
||||
@@ -2597,8 +2808,18 @@ ObjVarsGet(
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
if (IsPrivateDefine(interp)) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -2614,7 +2835,7 @@ ObjVarsSet(
|
||||
{
|
||||
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
|
||||
int varc, i;
|
||||
Tcl_Obj **varv, *variableObj;
|
||||
Tcl_Obj **varv;
|
||||
|
||||
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
|
||||
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
|
||||
@@ -2647,49 +2868,12 @@ ObjVarsSet(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
}
|
||||
for (i=0 ; i<varc ; i++) {
|
||||
Tcl_IncrRefCount(varv[i]);
|
||||
}
|
||||
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_DecrRefCount(variableObj);
|
||||
}
|
||||
if (i != varc) {
|
||||
if (varc == 0) {
|
||||
ckfree(oPtr->variables.list);
|
||||
} else if (i) {
|
||||
oPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * varc);
|
||||
} else {
|
||||
oPtr->variables.list = (Tcl_Obj **)
|
||||
ckalloc(sizeof(Tcl_Obj *) * varc);
|
||||
}
|
||||
}
|
||||
oPtr->variables.num = 0;
|
||||
if (varc > 0) {
|
||||
int created, n;
|
||||
Tcl_HashTable uniqueTable;
|
||||
|
||||
Tcl_InitObjHashTable(&uniqueTable);
|
||||
for (i=n=0 ; i<varc ; i++) {
|
||||
Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
|
||||
if (created) {
|
||||
oPtr->variables.list[n++] = varv[i];
|
||||
} else {
|
||||
Tcl_DecrRefCount(varv[i]);
|
||||
}
|
||||
}
|
||||
oPtr->variables.num = n;
|
||||
|
||||
/*
|
||||
* Shouldn't be necessary, but maintain num/list invariant.
|
||||
*/
|
||||
|
||||
oPtr->variables.list = (Tcl_Obj **)
|
||||
ckrealloc((char *) oPtr->variables.list,
|
||||
sizeof(Tcl_Obj *) * n);
|
||||
Tcl_DeleteHashTable(&uniqueTable);
|
||||
if (IsPrivateDefine(interp)) {
|
||||
InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
|
||||
oPtr->creationEpoch);
|
||||
} else {
|
||||
InstallStandardVariableMapping(&oPtr->variables, varc, varv);
|
||||
}
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
+165
-27
@@ -22,6 +22,7 @@ static Tcl_ObjCmdProc InfoObjectClassCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectDefnCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectForwardCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectIdCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectIsACmd;
|
||||
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
|
||||
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
|
||||
@@ -50,6 +51,7 @@ static Tcl_ObjCmdProc InfoClassVariablesCmd;
|
||||
static const EnsembleImplMap infoObjectCmds[] = {
|
||||
{"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
{"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
|
||||
{"creationid", InfoObjectIdCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
{"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
@@ -58,7 +60,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
|
||||
{"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
|
||||
{"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
|
||||
{"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"variables", InfoObjectVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{NULL, NULL, NULL, NULL, NULL, 0}
|
||||
};
|
||||
@@ -80,7 +82,7 @@ static const EnsembleImplMap infoClassCmds[] = {
|
||||
{"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
|
||||
{"variables", InfoClassVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
|
||||
{NULL, NULL, NULL, NULL, NULL, 0}
|
||||
};
|
||||
|
||||
@@ -517,15 +519,22 @@ InfoObjectMethodsCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Object *oPtr;
|
||||
int flag = PUBLIC_METHOD, recurse = 0;
|
||||
int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
|
||||
FOREACH_HASH_DECLS;
|
||||
Tcl_Obj *namePtr, *resultObj;
|
||||
Method *mPtr;
|
||||
static const char *const options[] = {
|
||||
"-all", "-localprivate", "-private", NULL
|
||||
"-all", "-localprivate", "-private", "-scope", NULL
|
||||
};
|
||||
enum Options {
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
|
||||
};
|
||||
static const char *const scopes[] = {
|
||||
"private", "public", "unexported"
|
||||
};
|
||||
enum Scopes {
|
||||
SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
|
||||
SCOPE_LOCALPRIVATE
|
||||
};
|
||||
|
||||
if (objc < 2) {
|
||||
@@ -554,14 +563,45 @@ InfoObjectMethodsCmd(
|
||||
case OPT_PRIVATE:
|
||||
flag = 0;
|
||||
break;
|
||||
case OPT_SCOPE:
|
||||
if (++i >= objc) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"missing option for -scope"));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
|
||||
&scope) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (scope != -1) {
|
||||
recurse = 0;
|
||||
switch (scope) {
|
||||
case SCOPE_PRIVATE:
|
||||
flag = TRUE_PRIVATE_METHOD;
|
||||
break;
|
||||
case SCOPE_PUBLIC:
|
||||
flag = PUBLIC_METHOD;
|
||||
break;
|
||||
case SCOPE_LOCALPRIVATE:
|
||||
flag = PRIVATE_METHOD;
|
||||
break;
|
||||
case SCOPE_UNEXPORTED:
|
||||
flag = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (recurse) {
|
||||
const char **names;
|
||||
int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
|
||||
int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
|
||||
&names);
|
||||
|
||||
for (i=0 ; i<numNames ; i++) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj,
|
||||
@@ -572,7 +612,7 @@ InfoObjectMethodsCmd(
|
||||
}
|
||||
} else if (oPtr->methodsPtr) {
|
||||
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
|
||||
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
|
||||
if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
|
||||
}
|
||||
}
|
||||
@@ -681,6 +721,38 @@ InfoObjectMixinsCmd(
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
* InfoObjectIdCmd --
|
||||
*
|
||||
* Implements [info object creationid $objName]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int
|
||||
InfoObjectIdCmd(
|
||||
ClientData clientData,
|
||||
Tcl_Interp *interp,
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Object *oPtr;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objName");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->creationEpoch));
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* ----------------------------------------------------------------------
|
||||
*
|
||||
@@ -719,7 +791,7 @@ InfoObjectNsCmd(
|
||||
*
|
||||
* InfoObjectVariablesCmd --
|
||||
*
|
||||
* Implements [info object variables $objName]
|
||||
* Implements [info object variables $objName ?-private?]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -732,21 +804,37 @@ InfoObjectVariablesCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Object *oPtr;
|
||||
Tcl_Obj *variableObj, *resultObj;
|
||||
int i;
|
||||
Tcl_Obj *resultObj;
|
||||
int i, private = 0;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objName");
|
||||
if (objc != 2 && objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 3) {
|
||||
if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
private = 1;
|
||||
}
|
||||
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
|
||||
if (oPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
if (private) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, oPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -1128,7 +1216,7 @@ InfoClassInstancesCmd(
|
||||
*
|
||||
* InfoClassMethodsCmd --
|
||||
*
|
||||
* Implements [info class methods $clsName ?-private?]
|
||||
* Implements [info class methods $clsName ?options...?]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1140,15 +1228,21 @@ InfoClassMethodsCmd(
|
||||
int objc,
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
int flag = PUBLIC_METHOD, recurse = 0;
|
||||
int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
|
||||
Tcl_Obj *namePtr, *resultObj;
|
||||
Method *mPtr;
|
||||
Class *clsPtr;
|
||||
static const char *const options[] = {
|
||||
"-all", "-localprivate", "-private", NULL
|
||||
"-all", "-localprivate", "-private", "-scope", NULL
|
||||
};
|
||||
enum Options {
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
|
||||
OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
|
||||
};
|
||||
static const char *const scopes[] = {
|
||||
"private", "public", "unexported"
|
||||
};
|
||||
enum Scopes {
|
||||
SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
|
||||
};
|
||||
|
||||
if (objc < 2) {
|
||||
@@ -1177,9 +1271,36 @@ InfoClassMethodsCmd(
|
||||
case OPT_PRIVATE:
|
||||
flag = 0;
|
||||
break;
|
||||
case OPT_SCOPE:
|
||||
if (++i >= objc) {
|
||||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||||
"missing option for -scope"));
|
||||
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
|
||||
NULL);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
|
||||
&scope) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (scope != -1) {
|
||||
recurse = 0;
|
||||
switch (scope) {
|
||||
case SCOPE_PRIVATE:
|
||||
flag = TRUE_PRIVATE_METHOD;
|
||||
break;
|
||||
case SCOPE_PUBLIC:
|
||||
flag = PUBLIC_METHOD;
|
||||
break;
|
||||
case SCOPE_UNEXPORTED:
|
||||
flag = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
if (recurse) {
|
||||
@@ -1197,7 +1318,7 @@ InfoClassMethodsCmd(
|
||||
FOREACH_HASH_DECLS;
|
||||
|
||||
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
|
||||
if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
|
||||
if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
|
||||
}
|
||||
}
|
||||
@@ -1399,7 +1520,7 @@ InfoClassSupersCmd(
|
||||
*
|
||||
* InfoClassVariablesCmd --
|
||||
*
|
||||
* Implements [info class variables $clsName]
|
||||
* Implements [info class variables $clsName ?-private?]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1412,21 +1533,37 @@ InfoClassVariablesCmd(
|
||||
Tcl_Obj *const objv[])
|
||||
{
|
||||
Class *clsPtr;
|
||||
Tcl_Obj *variableObj, *resultObj;
|
||||
int i;
|
||||
Tcl_Obj *resultObj;
|
||||
int i, private = 0;
|
||||
|
||||
if (objc != 2) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "className");
|
||||
if (objc != 2 && objc != 3) {
|
||||
Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
|
||||
return TCL_ERROR;
|
||||
}
|
||||
if (objc == 3) {
|
||||
if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
private = 1;
|
||||
}
|
||||
clsPtr = GetClassFromObj(interp, objv[1]);
|
||||
if (clsPtr == NULL) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
resultObj = Tcl_NewObj();
|
||||
FOREACH(variableObj, clsPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
if (private) {
|
||||
PrivateVariableMapping *privatePtr;
|
||||
|
||||
FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
|
||||
}
|
||||
} else {
|
||||
Tcl_Obj *variableObj;
|
||||
|
||||
FOREACH(variableObj, clsPtr->variables) {
|
||||
Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
|
||||
}
|
||||
}
|
||||
Tcl_SetObjResult(interp, resultObj);
|
||||
return TCL_OK;
|
||||
@@ -1465,7 +1602,8 @@ InfoObjectCallCmd(
|
||||
* Get the call context and render its call chain.
|
||||
*/
|
||||
|
||||
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
|
||||
contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
|
||||
NULL);
|
||||
if (contextPtr == NULL) {
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
||||
"cannot construct any call chain", -1));
|
||||
|
||||
+54
-4
@@ -124,6 +124,18 @@ typedef struct ForwardMethod {
|
||||
* non-empty list. */
|
||||
} ForwardMethod;
|
||||
|
||||
/*
|
||||
* Structure used in private variable mappings. Describes the mapping of a
|
||||
* single variable from the user's local name to the system's storage name.
|
||||
* [TIP #500]
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
Tcl_Obj *variableObj; /* Name used within methods. This is the part
|
||||
* that is properly under user control. */
|
||||
Tcl_Obj *fullNameObj; /* Name used at the instance namespace level. */
|
||||
} PrivateVariableMapping;
|
||||
|
||||
/*
|
||||
* Helper definitions that declare a "list" array. The two varieties are
|
||||
* either optimized for simplicity (in the case that the whole array is
|
||||
@@ -141,6 +153,13 @@ typedef struct ForwardMethod {
|
||||
#define LIST_DYNAMIC(listType_t) \
|
||||
struct { int num, size; listType_t *list; }
|
||||
|
||||
/*
|
||||
* These types are needed in function arguments.
|
||||
*/
|
||||
|
||||
typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
|
||||
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
|
||||
|
||||
/*
|
||||
* Now, the definition of what an object actually is.
|
||||
*/
|
||||
@@ -186,7 +205,10 @@ typedef struct Object {
|
||||
Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
|
||||
/* Function to allow remapping of method
|
||||
* names. For itcl-ng. */
|
||||
LIST_STATIC(Tcl_Obj *) variables;
|
||||
VariableNameList variables;
|
||||
PrivateVariableList privateVariables;
|
||||
/* Configurations for the variable resolver
|
||||
* used inside methods. */
|
||||
} Object;
|
||||
|
||||
#define OBJECT_DELETED 1 /* Flag to say that an object has been
|
||||
@@ -214,6 +236,10 @@ typedef struct Object {
|
||||
* other spots). */
|
||||
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
|
||||
* unknown method handler at that point. */
|
||||
#define HAS_PRIVATE_METHODS 0x20000
|
||||
/* Object/class has (or had) private methods,
|
||||
* and so shouldn't be cached so
|
||||
* aggressively. */
|
||||
|
||||
/*
|
||||
* And the definition of a class. Note that every class also has an associated
|
||||
@@ -268,7 +294,10 @@ typedef struct Class {
|
||||
* object doesn't override with its own mixins
|
||||
* (and filters and method implementations for
|
||||
* when getting method chains). */
|
||||
LIST_STATIC(Tcl_Obj *) variables;
|
||||
VariableNameList variables;
|
||||
PrivateVariableList privateVariables;
|
||||
/* Configurations for the variable resolver
|
||||
* used inside methods. */
|
||||
} Class;
|
||||
|
||||
/*
|
||||
@@ -370,10 +399,15 @@ typedef struct CallContext {
|
||||
|
||||
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
|
||||
#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
|
||||
* only) method. */
|
||||
* only) method. Supports itcl. */
|
||||
#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
|
||||
#define CONSTRUCTOR 0x08 /* This is a constructor. */
|
||||
#define DESTRUCTOR 0x10 /* This is a destructor. */
|
||||
#define TRUE_PRIVATE_METHOD 0x20
|
||||
/* This is a private method only accessible
|
||||
* from other methods defined on this class
|
||||
* or instance. [TIP #500] */
|
||||
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
|
||||
|
||||
/*
|
||||
* Structure containing definition information about basic class methods.
|
||||
@@ -431,6 +465,9 @@ MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
|
||||
MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
|
||||
Tcl_Interp *interp, int objc,
|
||||
Tcl_Obj *const *objv);
|
||||
@@ -504,6 +541,7 @@ MODULE_SCOPE void TclOODeleteContext(CallContext *contextPtr);
|
||||
MODULE_SCOPE void TclOODelMethodRef(Method *method);
|
||||
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
|
||||
Tcl_Obj *methodNameObj, int flags,
|
||||
Object *contextObjPtr, Class *contextClsPtr,
|
||||
Tcl_Obj *cacheInThisObj);
|
||||
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
|
||||
Tcl_Obj *methodNameObj, int flags);
|
||||
@@ -513,7 +551,8 @@ MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
|
||||
MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr);
|
||||
MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr,
|
||||
int flags, const char ***stringsPtr);
|
||||
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags,
|
||||
MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr,
|
||||
Object *contextObj, Class *contextCls, int flags,
|
||||
const char ***stringsPtr);
|
||||
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
|
||||
MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp);
|
||||
@@ -560,11 +599,22 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
|
||||
continue; \
|
||||
} else if (var = (ary).list[i], 1)
|
||||
|
||||
/*
|
||||
* A variation where the array is an array of structs. There's no issue with
|
||||
* possible NULLs; every element of the array will be iterated over and the
|
||||
* varable set to a pointer to each of those elements in turn.
|
||||
* REQUIRES DECLARATION: int i;
|
||||
*/
|
||||
|
||||
#define FOREACH_STRUCT(var,ary) \
|
||||
for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)
|
||||
|
||||
/*
|
||||
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
|
||||
* sets up the declarations needed for the main macro, FOREACH_HASH, which
|
||||
* does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
|
||||
* only iterates over values.
|
||||
* REQUIRES DECLARATION: FOREACH_HASH_DECLS;
|
||||
*/
|
||||
|
||||
#define FOREACH_HASH_DECLS \
|
||||
|
||||
+36
-3
@@ -186,7 +186,11 @@ Tcl_NewInstanceMethod(
|
||||
mPtr->declaringObjectPtr = oPtr;
|
||||
mPtr->declaringClassPtr = NULL;
|
||||
if (flags) {
|
||||
mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
|
||||
mPtr->flags |= flags &
|
||||
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
|
||||
if (flags & TRUE_PRIVATE_METHOD) {
|
||||
oPtr->flags |= HAS_PRIVATE_METHODS;
|
||||
}
|
||||
}
|
||||
oPtr->epoch++;
|
||||
return (Tcl_Method) mPtr;
|
||||
@@ -250,7 +254,11 @@ Tcl_NewMethod(
|
||||
mPtr->declaringObjectPtr = NULL;
|
||||
mPtr->declaringClassPtr = clsPtr;
|
||||
if (flags) {
|
||||
mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
|
||||
mPtr->flags |= flags &
|
||||
(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
|
||||
if (flags & TRUE_PRIVATE_METHOD) {
|
||||
clsPtr->flags |= HAS_PRIVATE_METHODS;
|
||||
}
|
||||
}
|
||||
|
||||
return (Tcl_Method) mPtr;
|
||||
@@ -928,7 +936,7 @@ PushMethodCallFrame(
|
||||
* variables used in methods. The compiled variable resolver is more
|
||||
* important, but both are needed as it is possible to have a variable
|
||||
* that is only referred to in ways that aren't compilable and we can't
|
||||
* force LVT presence. [TIP #320]
|
||||
* force LVT presence. [TIP #320, #500]
|
||||
*
|
||||
* ----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -986,6 +994,7 @@ ProcedureMethodCompiledVarConnect(
|
||||
CallFrame *framePtr = iPtr->varFramePtr;
|
||||
CallContext *contextPtr;
|
||||
Tcl_Obj *variableObj;
|
||||
PrivateVariableMapping *privateVar;
|
||||
Tcl_HashEntry *hPtr;
|
||||
int i, isNew, cacheIt, varLen, len;
|
||||
const char *match, *varName;
|
||||
@@ -1019,6 +1028,15 @@ ProcedureMethodCompiledVarConnect(
|
||||
varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
|
||||
if (contextPtr->callPtr->chain[contextPtr->index]
|
||||
.mPtr->declaringClassPtr != NULL) {
|
||||
FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
|
||||
.mPtr->declaringClassPtr->privateVariables) {
|
||||
match = TclGetStringFromObj(privateVar->variableObj, &len);
|
||||
if ((len == varLen) && !memcmp(match, varName, len)) {
|
||||
variableObj = privateVar->fullNameObj;
|
||||
cacheIt = 0;
|
||||
goto gotMatch;
|
||||
}
|
||||
}
|
||||
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
|
||||
.mPtr->declaringClassPtr->variables) {
|
||||
match = TclGetStringFromObj(variableObj, &len);
|
||||
@@ -1028,6 +1046,14 @@ ProcedureMethodCompiledVarConnect(
|
||||
}
|
||||
}
|
||||
} else {
|
||||
FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
|
||||
match = TclGetStringFromObj(privateVar->variableObj, &len);
|
||||
if ((len == varLen) && !memcmp(match, varName, len)) {
|
||||
variableObj = privateVar->fullNameObj;
|
||||
cacheIt = 1;
|
||||
goto gotMatch;
|
||||
}
|
||||
}
|
||||
FOREACH(variableObj, contextPtr->oPtr->variables) {
|
||||
match = TclGetStringFromObj(variableObj, &len);
|
||||
if ((len == varLen) && !memcmp(match, varName, len)) {
|
||||
@@ -1673,6 +1699,13 @@ Tcl_MethodIsPublic(
|
||||
{
|
||||
return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
|
||||
}
|
||||
|
||||
int
|
||||
Tcl_MethodIsPrivate(
|
||||
Tcl_Method method)
|
||||
{
|
||||
return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Extended method construction for itcl-ng.
|
||||
|
||||
@@ -73,6 +73,7 @@ const TclOOStubs tclOOStubs = {
|
||||
Tcl_ClassSetConstructor, /* 26 */
|
||||
Tcl_ClassSetDestructor, /* 27 */
|
||||
Tcl_GetObjectName, /* 28 */
|
||||
Tcl_MethodIsPrivate, /* 29 */
|
||||
};
|
||||
|
||||
/* !END!: Do not edit above this line. */
|
||||
|
||||
+474
-37
@@ -37,7 +37,7 @@ Tcl_Obj *tclFreeObjList = NULL;
|
||||
* TclNewObj macro, however, so must be visible.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
MODULE_SCOPE Tcl_Mutex tclObjMutex;
|
||||
Tcl_Mutex tclObjMutex;
|
||||
#endif
|
||||
@@ -50,14 +50,14 @@ Tcl_Mutex tclObjMutex;
|
||||
|
||||
char tclEmptyString = '\0';
|
||||
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
/*
|
||||
* Structure for tracking the source file and line number where a given
|
||||
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
|
||||
* for sanity checking purposes.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct ObjData {
|
||||
Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
|
||||
const char *file; /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
@@ -87,7 +87,7 @@ typedef struct {
|
||||
* tclCompile.h for the definition of this
|
||||
* structure, and for references to all
|
||||
* related places in the core. */
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
|
||||
* that a Tcl_Obj was not allocated by some
|
||||
* other thread. */
|
||||
@@ -156,7 +156,7 @@ typedef struct PendingObjData {
|
||||
/*
|
||||
* Macro to set up the local reference to the deletion context.
|
||||
*/
|
||||
#ifndef TCL_THREADS
|
||||
#if !TCL_THREADS
|
||||
static PendingObjData pendingObjData;
|
||||
#define ObjInitDeletionContext(contextPtr) \
|
||||
PendingObjData *const contextPtr = &pendingObjData
|
||||
@@ -210,6 +210,9 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
|
||||
static void UpdateStringOfInt(Tcl_Obj *objPtr);
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
|
||||
static void UpdateStringOfOldInt(Tcl_Obj *objPtr);
|
||||
#endif
|
||||
static void FreeBignum(Tcl_Obj *objPtr);
|
||||
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
|
||||
static void UpdateStringOfBignum(Tcl_Obj *objPtr);
|
||||
@@ -238,13 +241,22 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
|
||||
* implementations.
|
||||
*/
|
||||
|
||||
const Tcl_ObjType tclBooleanType = {
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
static const Tcl_ObjType oldBooleanType = {
|
||||
"boolean", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
TclSetBooleanFromAny /* setFromAnyProc */
|
||||
};
|
||||
#endif
|
||||
const Tcl_ObjType tclBooleanType = {
|
||||
"booleanString", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
NULL, /* updateStringProc */
|
||||
TclSetBooleanFromAny /* setFromAnyProc */
|
||||
};
|
||||
const Tcl_ObjType tclDoubleType = {
|
||||
"double", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
@@ -253,12 +265,25 @@ const Tcl_ObjType tclDoubleType = {
|
||||
SetDoubleFromAny /* setFromAnyProc */
|
||||
};
|
||||
const Tcl_ObjType tclIntType = {
|
||||
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
|
||||
"int", /* name */
|
||||
#else
|
||||
"wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
|
||||
#endif
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
UpdateStringOfInt, /* updateStringProc */
|
||||
SetIntFromAny /* setFromAnyProc */
|
||||
};
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
|
||||
static const Tcl_ObjType oldIntType = {
|
||||
"int", /* name */
|
||||
NULL, /* freeIntRepProc */
|
||||
NULL, /* dupIntRepProc */
|
||||
UpdateStringOfOldInt, /* updateStringProc */
|
||||
SetIntFromAny /* setFromAnyProc */
|
||||
};
|
||||
#endif
|
||||
const Tcl_ObjType tclBignumType = {
|
||||
"bignum", /* name */
|
||||
FreeBignum, /* freeIntRepProc */
|
||||
@@ -324,17 +349,17 @@ typedef struct ResolvedCmdName {
|
||||
* reference (not the namespace that contains
|
||||
* the referenced command). NULL if the name
|
||||
* is fully qualified.*/
|
||||
size_t refNsId; /* refNsPtr's unique namespace id. Used to
|
||||
unsigned long refNsId; /* refNsPtr's unique namespace id. Used to
|
||||
* verify that refNsPtr is still valid (e.g.,
|
||||
* it's possible that the cmd's containing
|
||||
* namespace was deleted and a new one created
|
||||
* at the same address). */
|
||||
size_t refNsCmdEpoch; /* Value of the referencing namespace's
|
||||
unsigned int refNsCmdEpoch; /* Value of the referencing namespace's
|
||||
* cmdRefEpoch when the pointer was cached.
|
||||
* Before using the cached pointer, we check
|
||||
* if the namespace's epoch was incremented;
|
||||
* if so, this cached pointer is invalid. */
|
||||
size_t cmdEpoch; /* Value of the command's cmdEpoch when this
|
||||
unsigned int cmdEpoch; /* Value of the command's cmdEpoch when this
|
||||
* pointer was cached. Before using the cached
|
||||
* pointer, we check if the cmd's epoch was
|
||||
* incremented; if so, the cmd was renamed,
|
||||
@@ -383,6 +408,15 @@ TclInitObjSubsystem(void)
|
||||
Tcl_RegisterObjType(&tclRegexpType);
|
||||
Tcl_RegisterObjType(&tclProcBodyType);
|
||||
|
||||
/* For backward compatibility only ... */
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
Tcl_RegisterObjType(&tclIntType);
|
||||
#if !defined(TCL_WIDE_INT_IS_LONG)
|
||||
Tcl_RegisterObjType(&oldIntType);
|
||||
#endif
|
||||
Tcl_RegisterObjType(&oldBooleanType);
|
||||
#endif
|
||||
|
||||
#ifdef TCL_COMPILE_STATS
|
||||
Tcl_MutexLock(&tclObjMutex);
|
||||
tclObjsAlloced = 0;
|
||||
@@ -418,7 +452,7 @@ TclInitObjSubsystem(void)
|
||||
void
|
||||
TclFinalizeThreadObjects(void)
|
||||
{
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashSearch hSearch;
|
||||
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
|
||||
@@ -975,7 +1009,7 @@ void
|
||||
TclDbDumpActiveObjects(
|
||||
FILE *outFile)
|
||||
{
|
||||
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
|
||||
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
|
||||
Tcl_HashSearch hSearch;
|
||||
Tcl_HashEntry *hPtr;
|
||||
Tcl_HashTable *tablePtr;
|
||||
@@ -1035,7 +1069,7 @@ TclDbInitNewObj(
|
||||
objPtr->length = 0;
|
||||
objPtr->typePtr = NULL;
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Add entry to a thread local map used to check if a Tcl_Obj was
|
||||
* allocated by the currently executing thread.
|
||||
@@ -1271,7 +1305,7 @@ TclFreeObj(
|
||||
|
||||
ObjInitDeletionContext(context);
|
||||
|
||||
# ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
@@ -1693,6 +1727,146 @@ Tcl_InvalidateStringRep(
|
||||
TclInvalidateStringRep(objPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_NewBooleanObj --
|
||||
*
|
||||
* This function is normally called when not debugging: i.e., when
|
||||
* TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
|
||||
* initializes it from the argument boolean value. A nonzero "boolValue"
|
||||
* is coerced to 1.
|
||||
*
|
||||
* When TCL_MEM_DEBUG is defined, this function just returns the result
|
||||
* of calling the debugging version Tcl_DbNewLongObj.
|
||||
*
|
||||
* Results:
|
||||
* The newly created object is returned. This object will have an invalid
|
||||
* string representation. The returned object has ref count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_NewBooleanObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewBooleanObj(
|
||||
register int boolValue) /* Boolean used to initialize new object. */
|
||||
{
|
||||
return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
|
||||
}
|
||||
|
||||
#else /* if not TCL_MEM_DEBUG */
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewBooleanObj(
|
||||
register int boolValue) /* Boolean used to initialize new object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, boolValue!=0);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* TCL_MEM_DEBUG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_DbNewBooleanObj --
|
||||
*
|
||||
* This function is normally called when debugging: i.e., when
|
||||
* TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
|
||||
* same as the Tcl_NewBooleanObj function above except that it calls
|
||||
* Tcl_DbCkalloc directly with the file name and line number from its
|
||||
* caller. This simplifies debugging since then the [memory active]
|
||||
* command will report the correct file name and line number when
|
||||
* reporting objects that haven't been freed.
|
||||
*
|
||||
* When TCL_MEM_DEBUG is not defined, this function just returns the
|
||||
* result of calling Tcl_NewBooleanObj.
|
||||
*
|
||||
* Results:
|
||||
* The newly created object is returned. This object will have an invalid
|
||||
* string representation. The returned object has ref count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
#undef Tcl_DbNewBooleanObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewBooleanObj(
|
||||
register int boolValue, /* Boolean used to initialize new object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
|
||||
objPtr->internalRep.wideValue = (boolValue != 0);
|
||||
objPtr->typePtr = &tclIntType;
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
#else /* if not TCL_MEM_DEBUG */
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewBooleanObj(
|
||||
register int boolValue, /* Boolean used to initialize new object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
return Tcl_NewBooleanObj(boolValue);
|
||||
}
|
||||
#endif /* TCL_MEM_DEBUG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SetBooleanObj --
|
||||
*
|
||||
* Modify an object to be a boolean object and to have the specified
|
||||
* boolean value. A nonzero "boolValue" is coerced to 1.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object's old string rep, if any, is freed. Also, any old internal
|
||||
* rep is freed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_SetBooleanObj
|
||||
void
|
||||
Tcl_SetBooleanObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register int boolValue) /* Boolean used to set object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
|
||||
}
|
||||
|
||||
TclSetIntObj(objPtr, boolValue!=0);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1719,10 +1893,14 @@ Tcl_GetBooleanFromObj(
|
||||
register int *boolPtr) /* Place to store resulting boolean. */
|
||||
{
|
||||
do {
|
||||
if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
|
||||
if (objPtr->typePtr == &tclIntType) {
|
||||
*boolPtr = (objPtr->internalRep.wideValue != 0);
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclBooleanType) {
|
||||
*boolPtr = objPtr->internalRep.longValue != 0;
|
||||
return TCL_OK;
|
||||
}
|
||||
if (objPtr->typePtr == &tclDoubleType) {
|
||||
/*
|
||||
* Caution: Don't be tempted to check directly for the "double"
|
||||
@@ -1764,7 +1942,12 @@ Tcl_GetBooleanFromObj(
|
||||
*
|
||||
* Side effects:
|
||||
* If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
|
||||
* representation and the type of "objPtr" is set to boolean or int.
|
||||
* representation and the type of "objPtr" is set to boolean or int/wideInt.
|
||||
*
|
||||
* Warning: If the returned type is "wideInt" (32-bit platforms) and your
|
||||
* platform is bigendian, you cannot use internalRep.longValue to distinguish
|
||||
* between false and true. On Windows and most other platforms this still will
|
||||
* work fine, but basically it is non-portable.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -1922,7 +2105,7 @@ ParseBoolean(
|
||||
|
||||
goodBoolean:
|
||||
TclFreeIntRep(objPtr);
|
||||
objPtr->internalRep.wideValue = newBool;
|
||||
objPtr->internalRep.longValue = newBool;
|
||||
objPtr->typePtr = &tclBooleanType;
|
||||
return TCL_OK;
|
||||
|
||||
@@ -2158,7 +2341,8 @@ SetDoubleFromAny(
|
||||
* UpdateStringOfDouble --
|
||||
*
|
||||
* Update the string representation for a double-precision floating point
|
||||
* object. Note: This function does not free an
|
||||
* object. This must obey the current tcl_precision value for
|
||||
* double-to-string conversions. Note: This function does not free an
|
||||
* existing old string rep so storage will be lost if this has not
|
||||
* already been done.
|
||||
*
|
||||
@@ -2187,31 +2371,112 @@ UpdateStringOfDouble(
|
||||
objPtr->length = len;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_NewIntObj --
|
||||
*
|
||||
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
|
||||
* Tcl_NewIntObj to create a new integer object end up calling the
|
||||
* debugging function Tcl_DbNewLongObj instead.
|
||||
*
|
||||
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
|
||||
* calls to Tcl_NewIntObj result in a call to one of the two
|
||||
* Tcl_NewIntObj implementations below. We provide two implementations so
|
||||
* that the Tcl core can be compiled to do memory debugging of the core
|
||||
* even if a client does not request it for itself.
|
||||
*
|
||||
* Integer and long integer objects share the same "integer" type
|
||||
* implementation. We store all integers as longs and Tcl_GetIntFromObj
|
||||
* checks whether the current value of the long can be represented by an
|
||||
* int.
|
||||
*
|
||||
* Results:
|
||||
* The newly created object is returned. This object will have an invalid
|
||||
* string representation. The returned object has ref count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_NewIntObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewIntObj(
|
||||
register int intValue) /* Int used to initialize the new object. */
|
||||
{
|
||||
return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
|
||||
}
|
||||
|
||||
#else /* if not TCL_MEM_DEBUG */
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewIntObj(
|
||||
register int intValue) /* Int used to initialize the new object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, intValue);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* if TCL_MEM_DEBUG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SetIntObj --
|
||||
*
|
||||
* Modify an object to be an integer and to have the specified integer
|
||||
* value.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object's old string rep, if any, is freed. Also, any old internal
|
||||
* rep is freed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_SetIntObj
|
||||
void
|
||||
Tcl_SetIntObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register int intValue) /* Integer used to set object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
|
||||
}
|
||||
|
||||
TclSetIntObj(objPtr, intValue);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_GetIntFromObj --
|
||||
*
|
||||
* Retrieve the integer value of 'objPtr'.
|
||||
* Attempt to return an int from the Tcl object "objPtr". If the object
|
||||
* is not already an int, an attempt will be made to convert it to one.
|
||||
*
|
||||
* Value
|
||||
* Integer and long integer objects share the same "integer" type
|
||||
* implementation. We store all integers as longs and Tcl_GetIntFromObj
|
||||
* checks whether the current value of the long can be represented by an
|
||||
* int.
|
||||
*
|
||||
* TCL_OK
|
||||
* Results:
|
||||
* The return value is a standard Tcl object result. If an error occurs
|
||||
* during conversion or if the long integer held by the object can not be
|
||||
* represented by an int, an error message is left in the interpreter's
|
||||
* result unless "interp" is NULL.
|
||||
*
|
||||
* Success.
|
||||
*
|
||||
* TCL_ERROR
|
||||
*
|
||||
* An error occurred during conversion or the integral value can not
|
||||
* be represented as an integer (it might be too large). An error
|
||||
* message is left in the interpreter's result if 'interp' is not
|
||||
* NULL.
|
||||
*
|
||||
* Effect
|
||||
*
|
||||
* 'objPtr' is converted to an integer if necessary if it is not one
|
||||
* already. The conversion frees any previously-existing internal
|
||||
* representation.
|
||||
* Side effects:
|
||||
* If the object is not already an int, the conversion will free any old
|
||||
* internal representation.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -2301,6 +2566,178 @@ UpdateStringOfInt(
|
||||
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
|
||||
static void
|
||||
UpdateStringOfOldInt(
|
||||
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
|
||||
{
|
||||
char buffer[TCL_INTEGER_SPACE];
|
||||
register int len;
|
||||
|
||||
len = TclFormatInt(buffer, objPtr->internalRep.longValue);
|
||||
|
||||
objPtr->bytes = ckalloc(len + 1);
|
||||
memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
|
||||
objPtr->length = len;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_NewLongObj --
|
||||
*
|
||||
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
|
||||
* Tcl_NewLongObj to create a new long integer object end up calling the
|
||||
* debugging function Tcl_DbNewLongObj instead.
|
||||
*
|
||||
* Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
|
||||
* calls to Tcl_NewLongObj result in a call to one of the two
|
||||
* Tcl_NewLongObj implementations below. We provide two implementations
|
||||
* so that the Tcl core can be compiled to do memory debugging of the
|
||||
* core even if a client does not request it for itself.
|
||||
*
|
||||
* Integer and long integer objects share the same "integer" type
|
||||
* implementation. We store all integers as longs and Tcl_GetIntFromObj
|
||||
* checks whether the current value of the long can be represented by an
|
||||
* int.
|
||||
*
|
||||
* Results:
|
||||
* The newly created object is returned. This object will have an invalid
|
||||
* string representation. The returned object has ref count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_NewLongObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewLongObj(
|
||||
register long longValue) /* Long integer used to initialize the
|
||||
* new object. */
|
||||
{
|
||||
return Tcl_DbNewLongObj(longValue, "unknown", 0);
|
||||
}
|
||||
|
||||
#else /* if not TCL_MEM_DEBUG */
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_NewLongObj(
|
||||
register long longValue) /* Long integer used to initialize the
|
||||
* new object. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclNewIntObj(objPtr, longValue);
|
||||
return objPtr;
|
||||
}
|
||||
#endif /* if TCL_MEM_DEBUG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_DbNewLongObj --
|
||||
*
|
||||
* If a client is compiled with TCL_MEM_DEBUG defined, calls to
|
||||
* Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
|
||||
* objects end up calling the debugging function Tcl_DbNewLongObj
|
||||
* instead. We provide two implementations of Tcl_DbNewLongObj so that
|
||||
* whether the Tcl core is compiled to do memory debugging of the core is
|
||||
* independent of whether a client requests debugging for itself.
|
||||
*
|
||||
* When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
|
||||
* calls Tcl_DbCkalloc directly with the file name and line number from
|
||||
* its caller. This simplifies debugging since then the [memory active]
|
||||
* command will report the caller's file name and line number when
|
||||
* reporting objects that haven't been freed.
|
||||
*
|
||||
* Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
|
||||
* this function just returns the result of calling Tcl_NewLongObj.
|
||||
*
|
||||
* Results:
|
||||
* The newly created long integer object is returned. This object will
|
||||
* have an invalid string representation. The returned object has ref
|
||||
* count 0.
|
||||
*
|
||||
* Side effects:
|
||||
* Allocates memory.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_DbNewLongObj
|
||||
#ifdef TCL_MEM_DEBUG
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewLongObj(
|
||||
register long longValue, /* Long integer used to initialize the new
|
||||
* object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
register Tcl_Obj *objPtr;
|
||||
|
||||
TclDbNewObj(objPtr, file, line);
|
||||
objPtr->bytes = NULL;
|
||||
|
||||
objPtr->internalRep.wideValue = longValue;
|
||||
objPtr->typePtr = &tclIntType;
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
#else /* if not TCL_MEM_DEBUG */
|
||||
|
||||
Tcl_Obj *
|
||||
Tcl_DbNewLongObj(
|
||||
register long longValue, /* Long integer used to initialize the new
|
||||
* object. */
|
||||
const char *file, /* The name of the source file calling this
|
||||
* function; used for debugging. */
|
||||
int line) /* Line number in the source file; used for
|
||||
* debugging. */
|
||||
{
|
||||
return Tcl_NewLongObj(longValue);
|
||||
}
|
||||
#endif /* TCL_MEM_DEBUG */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SetLongObj --
|
||||
*
|
||||
* Modify an object to be an integer object and to have the specified
|
||||
* long integer value.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The object's old string rep, if any, is freed. Also, any old internal
|
||||
* rep is freed.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_SetLongObj
|
||||
void
|
||||
Tcl_SetLongObj(
|
||||
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
|
||||
register long longValue) /* Long integer used to initialize the
|
||||
* object's value. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
|
||||
}
|
||||
|
||||
TclSetIntObj(objPtr, longValue);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -3161,7 +3598,7 @@ Tcl_DbIncrRefCount(
|
||||
Tcl_Panic("incrementing refCount of previously disposed object");
|
||||
}
|
||||
|
||||
# ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
@@ -3224,7 +3661,7 @@ Tcl_DbDecrRefCount(
|
||||
Tcl_Panic("decrementing refCount of previously disposed object");
|
||||
}
|
||||
|
||||
# ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
@@ -3289,7 +3726,7 @@ Tcl_DbIsShared(
|
||||
Tcl_Panic("checking whether previously disposed object is shared");
|
||||
}
|
||||
|
||||
# ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
/*
|
||||
* Check to make sure that the Tcl_Obj was allocated by the current
|
||||
* thread. Don't do this check when shutting down since thread local
|
||||
|
||||
@@ -287,6 +287,8 @@ ConvertZeroEffectToNOP(
|
||||
case INST_INCR_ARRAY_STK:
|
||||
case INST_INCR_SCALAR_STK:
|
||||
case INST_INCR_STK:
|
||||
case INST_LOR:
|
||||
case INST_LAND:
|
||||
case INST_EQ:
|
||||
case INST_NEQ:
|
||||
case INST_LT:
|
||||
|
||||
+44
-17
@@ -23,8 +23,8 @@
|
||||
* procedure.
|
||||
*/
|
||||
|
||||
#if defined(__CYGWIN__)
|
||||
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
|
||||
#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
|
||||
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
|
||||
#else
|
||||
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
|
||||
#endif
|
||||
@@ -45,6 +45,7 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#undef Tcl_SetPanicProc
|
||||
void
|
||||
Tcl_SetPanicProc(
|
||||
TCL_NORETURN1 Tcl_PanicProc *proc)
|
||||
@@ -63,7 +64,7 @@ Tcl_SetPanicProc(
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_Panic --
|
||||
* Tcl_PanicVA --
|
||||
*
|
||||
* Print an error message and kill the process.
|
||||
*
|
||||
@@ -76,25 +77,16 @@ Tcl_SetPanicProc(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
/*
|
||||
* The following comment is here so that Coverity's static analizer knows that
|
||||
* a Tcl_Panic() call can never return and avoids lots of false positives.
|
||||
*/
|
||||
|
||||
/* coverity[+kill] */
|
||||
void
|
||||
Tcl_Panic(
|
||||
const char *format,
|
||||
...)
|
||||
Tcl_PanicVA(
|
||||
const char *format, /* Format string, suitable for passing to
|
||||
* fprintf. */
|
||||
va_list argList) /* Variable argument list. */
|
||||
{
|
||||
va_list argList;
|
||||
char *arg1, *arg2, *arg3; /* Additional arguments (variable in number)
|
||||
* to pass to fprintf. */
|
||||
char *arg4, *arg5, *arg6, *arg7, *arg8;
|
||||
|
||||
|
||||
va_start(argList, format);
|
||||
arg1 = va_arg(argList, char *);
|
||||
arg2 = va_arg(argList, char *);
|
||||
arg3 = va_arg(argList, char *);
|
||||
@@ -103,7 +95,6 @@ Tcl_Panic(
|
||||
arg6 = va_arg(argList, char *);
|
||||
arg7 = va_arg(argList, char *);
|
||||
arg8 = va_arg(argList, char *);
|
||||
va_end (argList);
|
||||
|
||||
if (panicProc != NULL) {
|
||||
panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
|
||||
@@ -135,6 +126,42 @@ Tcl_Panic(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_Panic --
|
||||
*
|
||||
* Print an error message and kill the process.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The process dies, entering the debugger if possible.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
/* ARGSUSED */
|
||||
|
||||
/*
|
||||
* The following comment is here so that Coverity's static analizer knows that
|
||||
* a Tcl_Panic() call can never return and avoids lots of false positives.
|
||||
*/
|
||||
|
||||
/* coverity[+kill] */
|
||||
void
|
||||
Tcl_Panic(
|
||||
const char *format,
|
||||
...)
|
||||
{
|
||||
va_list argList;
|
||||
|
||||
va_start(argList, format);
|
||||
Tcl_PanicVA(format, argList);
|
||||
va_end (argList);
|
||||
}
|
||||
|
||||
/*
|
||||
* Local Variables:
|
||||
* mode: c
|
||||
|
||||
@@ -72,7 +72,7 @@ static const Tcl_ObjType tclFsPathType = {
|
||||
*
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct FsPath {
|
||||
Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
|
||||
* is NULL, then this is a pure normalized,
|
||||
* absolute path object, in which the parent
|
||||
@@ -91,7 +91,7 @@ typedef struct {
|
||||
* below. */
|
||||
ClientData nativePathPtr; /* Native representation of this path, which
|
||||
* is filesystem dependent. */
|
||||
size_t filesystemEpoch; /* Used to ensure the path representation was
|
||||
int filesystemEpoch; /* Used to ensure the path representation was
|
||||
* generated during the correct filesystem
|
||||
* epoch. The epoch changes when
|
||||
* filesystem-mounts are changed. */
|
||||
|
||||
+1
-1
@@ -55,7 +55,7 @@ typedef struct PkgFiles {
|
||||
* "Tk" (no version number).
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct Package {
|
||||
char *version; /* Version that has been supplied in this
|
||||
* interpreter via "package provide"
|
||||
* (malloc'ed). NULL means the package doesn't
|
||||
|
||||
@@ -40,7 +40,7 @@
|
||||
* configuration information.
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
# define CFG_THREADED "1"
|
||||
#else
|
||||
# define CFG_THREADED "0"
|
||||
|
||||
@@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */
|
||||
* objects that we don't want to live any longer than necessary.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct HandleStruct {
|
||||
void *ptr; /* Pointer to the memory block being tracked.
|
||||
* This field will become NULL when the memory
|
||||
* block is deleted. This field must be the
|
||||
|
||||
+5
-1
@@ -1051,7 +1051,11 @@ ProcWrongNumArgs(
|
||||
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
|
||||
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
|
||||
} else {
|
||||
#ifdef AVOID_HACKS_FOR_ITCL
|
||||
desiredObjs[0] = framePtr->objv[skip-1];
|
||||
#else
|
||||
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
|
||||
#endif /* AVOID_HACKS_FOR_ITCL */
|
||||
}
|
||||
Tcl_IncrRefCount(desiredObjs[0]);
|
||||
|
||||
@@ -1310,7 +1314,7 @@ InitLocalCache(
|
||||
*namePtr = NULL;
|
||||
} else {
|
||||
*namePtr = TclCreateLiteral(iPtr, localPtr->name,
|
||||
localPtr->nameLength, /* hash */ -1,
|
||||
localPtr->nameLength, /* hash */ (unsigned int) -1,
|
||||
&new, /* nsPtr */ NULL, 0, NULL);
|
||||
Tcl_IncrRefCount(*namePtr);
|
||||
}
|
||||
|
||||
+420
-49
@@ -27,6 +27,9 @@ enum returnKeys {
|
||||
static Tcl_Obj ** GetKeys(void);
|
||||
static void ReleaseKeys(ClientData clientData);
|
||||
static void ResetObjResult(Interp *iPtr);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
static void SetupAppendBuffer(Interp *iPtr, int newSpace);
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
* This structure is used to take a snapshot of the interpreter state in
|
||||
@@ -244,9 +247,47 @@ Tcl_SaveResult(
|
||||
* reference. Put an empty object into the interpreter.
|
||||
*/
|
||||
|
||||
*statePtr = iPtr->objResultPtr;
|
||||
statePtr->objResultPtr = iPtr->objResultPtr;
|
||||
iPtr->objResultPtr = Tcl_NewObj();
|
||||
Tcl_IncrRefCount(iPtr->objResultPtr);
|
||||
|
||||
/*
|
||||
* Save the string result.
|
||||
*/
|
||||
|
||||
statePtr->freeProc = iPtr->freeProc;
|
||||
if (iPtr->result == iPtr->resultSpace) {
|
||||
/*
|
||||
* Copy the static string data out of the interp buffer.
|
||||
*/
|
||||
|
||||
statePtr->result = statePtr->resultSpace;
|
||||
strcpy(statePtr->result, iPtr->result);
|
||||
statePtr->appendResult = NULL;
|
||||
} else if (iPtr->result == iPtr->appendResult) {
|
||||
/*
|
||||
* Move the append buffer out of the interp.
|
||||
*/
|
||||
|
||||
statePtr->appendResult = iPtr->appendResult;
|
||||
statePtr->appendAvl = iPtr->appendAvl;
|
||||
statePtr->appendUsed = iPtr->appendUsed;
|
||||
statePtr->result = statePtr->appendResult;
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
iPtr->appendUsed = 0;
|
||||
} else {
|
||||
/*
|
||||
* Move the dynamic or static string out of the interpreter.
|
||||
*/
|
||||
|
||||
statePtr->result = iPtr->result;
|
||||
statePtr->appendResult = NULL;
|
||||
}
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -277,12 +318,45 @@ Tcl_RestoreResult(
|
||||
|
||||
Tcl_ResetResult(interp);
|
||||
|
||||
/*
|
||||
* Restore the string result.
|
||||
*/
|
||||
|
||||
iPtr->freeProc = statePtr->freeProc;
|
||||
if (statePtr->result == statePtr->resultSpace) {
|
||||
/*
|
||||
* Copy the static string data into the interp buffer.
|
||||
*/
|
||||
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
strcpy(iPtr->result, statePtr->result);
|
||||
} else if (statePtr->result == statePtr->appendResult) {
|
||||
/*
|
||||
* Move the append buffer back into the interp.
|
||||
*/
|
||||
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
}
|
||||
|
||||
iPtr->appendResult = statePtr->appendResult;
|
||||
iPtr->appendAvl = statePtr->appendAvl;
|
||||
iPtr->appendUsed = statePtr->appendUsed;
|
||||
iPtr->result = iPtr->appendResult;
|
||||
} else {
|
||||
/*
|
||||
* Move the dynamic or static string back into the interpreter.
|
||||
*/
|
||||
|
||||
iPtr->result = statePtr->result;
|
||||
}
|
||||
|
||||
/*
|
||||
* Restore the object result.
|
||||
*/
|
||||
|
||||
Tcl_DecrRefCount(iPtr->objResultPtr);
|
||||
iPtr->objResultPtr = *statePtr;
|
||||
iPtr->objResultPtr = statePtr->objResultPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -308,7 +382,15 @@ void
|
||||
Tcl_DiscardResult(
|
||||
Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
|
||||
{
|
||||
Tcl_DecrRefCount(*statePtr);
|
||||
TclDecrRefCount(statePtr->objResultPtr);
|
||||
|
||||
if (statePtr->result == statePtr->appendResult) {
|
||||
ckfree(statePtr->appendResult);
|
||||
} else if (statePtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(statePtr->result);
|
||||
} else if (statePtr->freeProc) {
|
||||
statePtr->freeProc(statePtr->result);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -338,15 +420,49 @@ Tcl_SetResult(
|
||||
* TCL_STATIC, TCL_VOLATILE, or the address of
|
||||
* a Tcl_FreeProc such as free. */
|
||||
{
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
|
||||
if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
|
||||
return;
|
||||
}
|
||||
if (freeProc == TCL_DYNAMIC) {
|
||||
ckfree(result);
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
|
||||
char *oldResult = iPtr->result;
|
||||
|
||||
if (result == NULL) {
|
||||
iPtr->resultSpace[0] = 0;
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->freeProc = 0;
|
||||
} else if (freeProc == TCL_VOLATILE) {
|
||||
int length = strlen(result);
|
||||
|
||||
if (length > TCL_RESULT_SIZE) {
|
||||
iPtr->result = ckalloc(length + 1);
|
||||
iPtr->freeProc = TCL_DYNAMIC;
|
||||
} else {
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
memcpy(iPtr->result, result, (unsigned) length+1);
|
||||
} else {
|
||||
(*freeProc)(result);
|
||||
iPtr->result = (char *) result;
|
||||
iPtr->freeProc = freeProc;
|
||||
}
|
||||
|
||||
/*
|
||||
* If the old result was dynamically-allocated, free it up. Do it here,
|
||||
* rather than at the beginning, in case the new result value was part of
|
||||
* the old result value.
|
||||
*/
|
||||
|
||||
if (oldFreeProc != 0) {
|
||||
if (oldFreeProc == TCL_DYNAMIC) {
|
||||
ckfree(oldResult);
|
||||
} else {
|
||||
oldFreeProc(oldResult);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Reset the object result since we just set the string result.
|
||||
*/
|
||||
|
||||
ResetObjResult(iPtr);
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
@@ -372,8 +488,20 @@ Tcl_GetStringResult(
|
||||
register Tcl_Interp *interp)/* Interpreter whose result to return. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
return Tcl_GetString(iPtr->objResultPtr);
|
||||
#else
|
||||
/*
|
||||
* If the string result is empty, move the object result to the string
|
||||
* result, then reset the object result.
|
||||
*/
|
||||
|
||||
if (*(iPtr->result) == 0) {
|
||||
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
|
||||
TCL_VOLATILE);
|
||||
}
|
||||
return iPtr->result;
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -414,6 +542,23 @@ Tcl_SetObjResult(
|
||||
*/
|
||||
|
||||
TclDecrRefCount(oldObjResult);
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
/*
|
||||
* Reset the string result since we just set the result object.
|
||||
*/
|
||||
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -442,10 +587,72 @@ Tcl_GetObjResult(
|
||||
Tcl_Interp *interp) /* Interpreter whose result to return. */
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
Tcl_Obj *objResultPtr;
|
||||
int length;
|
||||
|
||||
/*
|
||||
* If the string result is non-empty, move the string result to the object
|
||||
* result, then reset the string result.
|
||||
*/
|
||||
|
||||
if (iPtr->result[0] != 0) {
|
||||
ResetObjResult(iPtr);
|
||||
|
||||
objResultPtr = iPtr->objResultPtr;
|
||||
length = strlen(iPtr->result);
|
||||
TclInitStringRep(objResultPtr, iPtr->result, length);
|
||||
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->result[0] = 0;
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
return iPtr->objResultPtr;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_AppendResultVA --
|
||||
*
|
||||
* Append a variable number of strings onto the interpreter's result.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The result of the interpreter given by the first argument is extended
|
||||
* by the strings in the va_list (up to a terminating NULL argument).
|
||||
*
|
||||
* If the string result is non-empty, the object result forced to be a
|
||||
* duplicate of it first. There will be a string result afterwards.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
Tcl_AppendResultVA(
|
||||
Tcl_Interp *interp, /* Interpreter with which to associate the
|
||||
* return value. */
|
||||
va_list argList) /* Variable argument list. */
|
||||
{
|
||||
Tcl_Obj *objPtr = Tcl_GetObjResult(interp);
|
||||
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
objPtr = Tcl_DuplicateObj(objPtr);
|
||||
}
|
||||
Tcl_AppendStringsToObjVA(objPtr, argList);
|
||||
Tcl_SetObjResult(interp, objPtr);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -472,23 +679,9 @@ Tcl_AppendResult(
|
||||
Tcl_Interp *interp, ...)
|
||||
{
|
||||
va_list argList;
|
||||
Tcl_Obj *objPtr;
|
||||
|
||||
va_start(argList, interp);
|
||||
objPtr = Tcl_GetObjResult(interp);
|
||||
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
objPtr = Tcl_DuplicateObj(objPtr);
|
||||
}
|
||||
while (1) {
|
||||
const char *bytes = va_arg(argList, char *);
|
||||
|
||||
if (bytes == NULL) {
|
||||
break;
|
||||
}
|
||||
Tcl_AppendToObj(objPtr, bytes, -1);
|
||||
}
|
||||
Tcl_SetObjResult(interp, objPtr);
|
||||
Tcl_AppendResultVA(interp, argList);
|
||||
va_end(argList);
|
||||
}
|
||||
|
||||
@@ -523,6 +716,7 @@ Tcl_AppendElement(
|
||||
* to result. */
|
||||
{
|
||||
Interp *iPtr = (Interp *) interp;
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
|
||||
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
|
||||
const char *bytes;
|
||||
@@ -536,25 +730,153 @@ Tcl_AppendElement(
|
||||
}
|
||||
Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
|
||||
Tcl_DecrRefCount(listPtr);
|
||||
#else
|
||||
char *dst;
|
||||
int size;
|
||||
int flags;
|
||||
|
||||
/*
|
||||
* If the string result is empty, move the object result to the string
|
||||
* result, then reset the object result.
|
||||
*/
|
||||
|
||||
(void) Tcl_GetStringResult(interp);
|
||||
|
||||
/*
|
||||
* See how much space is needed, and grow the append buffer if needed to
|
||||
* accommodate the list element.
|
||||
*/
|
||||
|
||||
size = Tcl_ScanElement(element, &flags) + 1;
|
||||
if ((iPtr->result != iPtr->appendResult)
|
||||
|| (iPtr->appendResult[iPtr->appendUsed] != 0)
|
||||
|| ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
|
||||
SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
|
||||
}
|
||||
|
||||
/*
|
||||
* Convert the string into a list element and copy it to the buffer that's
|
||||
* forming, with a space separator if needed.
|
||||
*/
|
||||
|
||||
dst = iPtr->appendResult + iPtr->appendUsed;
|
||||
if (TclNeedSpace(iPtr->appendResult, dst)) {
|
||||
iPtr->appendUsed++;
|
||||
*dst = ' ';
|
||||
dst++;
|
||||
|
||||
/*
|
||||
* If we need a space to separate this element from preceding stuff,
|
||||
* then this element will not lead a list, and need not have it's
|
||||
* leading '#' quoted.
|
||||
*/
|
||||
|
||||
flags |= TCL_DONT_QUOTE_HASH;
|
||||
}
|
||||
iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* SetupAppendBuffer --
|
||||
*
|
||||
* This function makes sure that there is an append buffer properly
|
||||
* initialized, if necessary, from the interpreter's result, and that it
|
||||
* has at least enough room to accommodate newSpace new bytes of
|
||||
* information.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
static void
|
||||
SetupAppendBuffer(
|
||||
Interp *iPtr, /* Interpreter whose result is being set up. */
|
||||
int newSpace) /* Make sure that at least this many bytes of
|
||||
* new information may be added. */
|
||||
{
|
||||
int totalSpace;
|
||||
|
||||
/*
|
||||
* Make the append buffer larger, if that's necessary, then copy the
|
||||
* result into the append buffer and make the append buffer the official
|
||||
* Tcl result.
|
||||
*/
|
||||
|
||||
if (iPtr->result != iPtr->appendResult) {
|
||||
/*
|
||||
* If an oversized buffer was used recently, then free it up so we go
|
||||
* back to a smaller buffer. This avoids tying up memory forever after
|
||||
* a large operation.
|
||||
*/
|
||||
|
||||
if (iPtr->appendAvl > 500) {
|
||||
ckfree(iPtr->appendResult);
|
||||
iPtr->appendResult = NULL;
|
||||
iPtr->appendAvl = 0;
|
||||
}
|
||||
iPtr->appendUsed = strlen(iPtr->result);
|
||||
} else if (iPtr->result[iPtr->appendUsed] != 0) {
|
||||
/*
|
||||
* Most likely someone has modified a result created by
|
||||
* Tcl_AppendResult et al. so that it has a different size. Just
|
||||
* recompute the size.
|
||||
*/
|
||||
|
||||
iPtr->appendUsed = strlen(iPtr->result);
|
||||
}
|
||||
|
||||
totalSpace = newSpace + iPtr->appendUsed;
|
||||
if (totalSpace >= iPtr->appendAvl) {
|
||||
char *new;
|
||||
|
||||
if (totalSpace < 100) {
|
||||
totalSpace = 200;
|
||||
} else {
|
||||
totalSpace *= 2;
|
||||
}
|
||||
new = ckalloc(totalSpace);
|
||||
strcpy(new, iPtr->result);
|
||||
if (iPtr->appendResult != NULL) {
|
||||
ckfree(iPtr->appendResult);
|
||||
}
|
||||
iPtr->appendResult = new;
|
||||
iPtr->appendAvl = totalSpace;
|
||||
} else if (iPtr->result != iPtr->appendResult) {
|
||||
strcpy(iPtr->appendResult, iPtr->result);
|
||||
}
|
||||
|
||||
Tcl_FreeResult((Tcl_Interp *) iPtr);
|
||||
iPtr->result = iPtr->appendResult;
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_FreeResult --
|
||||
*
|
||||
* This function frees up the memory associated with an interpreter's
|
||||
* result, resetting the interpreter's result object. Tcl_FreeResult is
|
||||
* most commonly used when a function is about to replace one result
|
||||
* value with another.
|
||||
* string result. It also resets the interpreter's result object.
|
||||
* Tcl_FreeResult is most commonly used when a function is about to
|
||||
* replace one result value with another.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* Frees the memory associated with interp's result but does not change
|
||||
* any part of the error dictionary (i.e., the errorinfo and errorcode
|
||||
* remain the same).
|
||||
* Frees the memory associated with interp's string result and sets
|
||||
* interp->freeProc to zero, but does not change interp->result or clear
|
||||
* error state. Resets interp's result object to an unshared empty
|
||||
* object.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
@@ -565,6 +887,17 @@ Tcl_FreeResult(
|
||||
{
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
ResetObjResult(iPtr);
|
||||
}
|
||||
|
||||
@@ -594,6 +927,18 @@ Tcl_ResetResult(
|
||||
register Interp *iPtr = (Interp *) interp;
|
||||
|
||||
ResetObjResult(iPtr);
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
if (iPtr->freeProc != NULL) {
|
||||
if (iPtr->freeProc == TCL_DYNAMIC) {
|
||||
ckfree(iPtr->result);
|
||||
} else {
|
||||
iPtr->freeProc(iPtr->result);
|
||||
}
|
||||
iPtr->freeProc = 0;
|
||||
}
|
||||
iPtr->result = iPtr->resultSpace;
|
||||
iPtr->resultSpace[0] = 0;
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
if (iPtr->errorCode) {
|
||||
/* Legacy support */
|
||||
if (iPtr->flags & ERR_LEGACY_COPY) {
|
||||
@@ -664,6 +1009,48 @@ ResetObjResult(
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SetErrorCodeVA --
|
||||
*
|
||||
* This function is called to record machine-readable information about
|
||||
* an error that is about to be returned.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The errorCode field of the interp is modified to hold all of the
|
||||
* arguments to this function, in a list form with each argument becoming
|
||||
* one element of the list.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
Tcl_SetErrorCodeVA(
|
||||
Tcl_Interp *interp, /* Interpreter in which to set errorCode */
|
||||
va_list argList) /* Variable argument list. */
|
||||
{
|
||||
Tcl_Obj *errorObj = Tcl_NewObj();
|
||||
|
||||
/*
|
||||
* Scan through the arguments one at a time, appending them to the
|
||||
* errorCode field as list elements.
|
||||
*/
|
||||
|
||||
while (1) {
|
||||
char *elem = va_arg(argList, char *);
|
||||
|
||||
if (elem == NULL) {
|
||||
break;
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
|
||||
}
|
||||
Tcl_SetObjErrorCode(interp, errorObj);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -688,7 +1075,6 @@ Tcl_SetErrorCode(
|
||||
Tcl_Interp *interp, ...)
|
||||
{
|
||||
va_list argList;
|
||||
Tcl_Obj *errorObj;
|
||||
|
||||
/*
|
||||
* Scan through the arguments one at a time, appending them to the
|
||||
@@ -696,22 +1082,7 @@ Tcl_SetErrorCode(
|
||||
*/
|
||||
|
||||
va_start(argList, interp);
|
||||
errorObj = Tcl_NewObj();
|
||||
|
||||
/*
|
||||
* Scan through the arguments one at a time, appending them to the
|
||||
* errorCode field as list elements.
|
||||
*/
|
||||
|
||||
while (1) {
|
||||
char *elem = va_arg(argList, char *);
|
||||
|
||||
if (elem == NULL) {
|
||||
break;
|
||||
}
|
||||
Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
|
||||
}
|
||||
Tcl_SetObjErrorCode(interp, errorObj);
|
||||
Tcl_SetErrorCodeVA(interp, argList);
|
||||
va_end(argList);
|
||||
}
|
||||
|
||||
|
||||
+1
-1
@@ -29,7 +29,7 @@
|
||||
* character set.
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct CharSet {
|
||||
int exclude; /* 1 if this is an exclusion set. */
|
||||
int nchars;
|
||||
Tcl_UniChar *chars;
|
||||
|
||||
+70
-6
@@ -483,7 +483,7 @@ TclParseNumber(
|
||||
enum State {
|
||||
INITIAL, SIGNUM, ZERO, ZERO_X,
|
||||
ZERO_O, ZERO_B, ZERO_D, BINARY,
|
||||
HEXADECIMAL, OCTAL, DECIMAL,
|
||||
HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
|
||||
LEADING_RADIX_POINT, FRACTION,
|
||||
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
|
||||
sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
|
||||
@@ -528,6 +528,7 @@ TclParseNumber(
|
||||
char d = 0; /* Last hexadecimal digit scanned; initialized
|
||||
* to avoid a compiler warning. */
|
||||
int shift = 0; /* Amount to shift when accumulating binary */
|
||||
int explicitOctal = 0;
|
||||
|
||||
#define ALL_BITS (~(Tcl_WideUInt)0)
|
||||
#define MOST_BITS (ALL_BITS >> 1)
|
||||
@@ -659,6 +660,7 @@ TclParseNumber(
|
||||
goto zerob;
|
||||
}
|
||||
if (c == 'o' || c == 'O') {
|
||||
explicitOctal = 1;
|
||||
state = ZERO_O;
|
||||
break;
|
||||
}
|
||||
@@ -666,7 +668,10 @@ TclParseNumber(
|
||||
state = ZERO_D;
|
||||
break;
|
||||
}
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
goto decimal;
|
||||
#endif
|
||||
/* FALLTHROUGH */
|
||||
|
||||
case OCTAL:
|
||||
/*
|
||||
@@ -729,6 +734,58 @@ TclParseNumber(
|
||||
state = OCTAL;
|
||||
break;
|
||||
}
|
||||
/* FALLTHROUGH */
|
||||
|
||||
case BAD_OCTAL:
|
||||
if (explicitOctal) {
|
||||
/*
|
||||
* No forgiveness for bad digits in explicitly octal numbers.
|
||||
*/
|
||||
|
||||
goto endgame;
|
||||
}
|
||||
if (flags & TCL_PARSE_INTEGER_ONLY) {
|
||||
/*
|
||||
* No seeking floating point when parsing only integer.
|
||||
*/
|
||||
|
||||
goto endgame;
|
||||
}
|
||||
#ifndef TCL_NO_DEPRECATED
|
||||
|
||||
/*
|
||||
* Scanned a number with a leading zero that contains an 8, 9,
|
||||
* radix point or E. This is an invalid octal number, but might
|
||||
* still be floating point.
|
||||
*/
|
||||
|
||||
if (c == '0') {
|
||||
numTrailZeros++;
|
||||
state = BAD_OCTAL;
|
||||
break;
|
||||
} else if (isdigit(UCHAR(c))) {
|
||||
if (objPtr != NULL) {
|
||||
significandOverflow = AccumulateDecimalDigit(
|
||||
(unsigned)(c-'0'), numTrailZeros,
|
||||
&significandWide, &significandBig,
|
||||
significandOverflow);
|
||||
}
|
||||
if (numSigDigs != 0) {
|
||||
numSigDigs += (numTrailZeros + 1);
|
||||
} else {
|
||||
numSigDigs = 1;
|
||||
}
|
||||
numTrailZeros = 0;
|
||||
state = BAD_OCTAL;
|
||||
break;
|
||||
} else if (c == '.') {
|
||||
state = FRACTION;
|
||||
break;
|
||||
} else if (c == 'E' || c == 'e') {
|
||||
state = EXPONENT_START;
|
||||
break;
|
||||
}
|
||||
#endif
|
||||
goto endgame;
|
||||
|
||||
/*
|
||||
@@ -843,7 +900,9 @@ TclParseNumber(
|
||||
* digits.
|
||||
*/
|
||||
|
||||
#ifdef TCL_NO_DEPRECATED
|
||||
decimal:
|
||||
#endif
|
||||
acceptState = state;
|
||||
acceptPoint = p;
|
||||
acceptLen = len;
|
||||
@@ -1127,6 +1186,7 @@ TclParseNumber(
|
||||
TclFreeIntRep(objPtr);
|
||||
switch (acceptState) {
|
||||
case SIGNUM:
|
||||
case BAD_OCTAL:
|
||||
case ZERO_X:
|
||||
case ZERO_O:
|
||||
case ZERO_B:
|
||||
@@ -1324,6 +1384,9 @@ TclParseNumber(
|
||||
|
||||
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
|
||||
Tcl_AppendToObj(msg, "\"", -1);
|
||||
if (state == BAD_OCTAL) {
|
||||
Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
|
||||
}
|
||||
Tcl_SetObjResult(interp, msg);
|
||||
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
|
||||
}
|
||||
@@ -3968,8 +4031,8 @@ StrictBignumConversion(
|
||||
* This function is a service routine that produces the string of digits for
|
||||
* floating-point-to-decimal conversion. It can do a number of things
|
||||
* according to the 'flags' argument. Valid values for 'flags' include:
|
||||
* TCL_DD_SHORTEST - This is the default for floating point conversion.
|
||||
* It constructs the shortest string of
|
||||
* TCL_DD_SHORTEST - This is the default for floating point conversion if
|
||||
* ::tcl_precision is 0. It constructs the shortest string of
|
||||
* digits that will reconvert to the given number when scanned.
|
||||
* For floating point numbers that are exactly between two
|
||||
* decimal numbers, it resolves using the 'round to even' rule.
|
||||
@@ -3984,7 +4047,8 @@ StrictBignumConversion(
|
||||
* subsequent input conversion is 'round up' or 'round down'
|
||||
* rather than 'round to nearest', but is surprising otherwise.
|
||||
* TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format
|
||||
* conversion. It constructs a string of at most 'ndigits' digits,
|
||||
* conversion (or for default floating->string if tcl_precision
|
||||
* is not 0). It constructs a string of at most 'ndigits' digits,
|
||||
* choosing the one that is closest to the given number (and
|
||||
* resolving ties with 'round to even'). It is allowed to return
|
||||
* fewer than 'ndigits' if the number converts exactly; if the
|
||||
@@ -4479,7 +4543,7 @@ Tcl_InitBignumFromDouble(
|
||||
return TCL_ERROR;
|
||||
}
|
||||
|
||||
fract = frexp(d,&expt);
|
||||
fract = frexp(d, &expt);
|
||||
if (expt <= 0) {
|
||||
mp_init(b);
|
||||
mp_zero(b);
|
||||
@@ -4819,7 +4883,7 @@ Pow10TimesFrExp(
|
||||
* Multiply by 10**exponent.
|
||||
*/
|
||||
|
||||
retval = frexp(retval * pow10vals[exponent&0xf], &j);
|
||||
retval = frexp(retval * pow10vals[exponent & 0xf], &j);
|
||||
expt += j;
|
||||
for (i=4; i<9; ++i) {
|
||||
if (exponent & (1<<i)) {
|
||||
|
||||
+351
-105
@@ -436,7 +436,6 @@ Tcl_GetCharLength(
|
||||
return length;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* OK, need to work with the object as a string.
|
||||
*/
|
||||
@@ -455,8 +454,6 @@ Tcl_GetCharLength(
|
||||
}
|
||||
return numChars;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
@@ -475,16 +472,16 @@ Tcl_GetCharLength(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
int
|
||||
TclCheckEmptyString (
|
||||
Tcl_Obj *objPtr
|
||||
) {
|
||||
TclCheckEmptyString(
|
||||
Tcl_Obj *objPtr)
|
||||
{
|
||||
int length = -1;
|
||||
|
||||
if (objPtr->bytes == tclEmptyStringRep) {
|
||||
if (objPtr->bytes == &tclEmptyString) {
|
||||
return TCL_EMPTYSTRING_YES;
|
||||
}
|
||||
|
||||
if (TclIsPureList(objPtr)) {
|
||||
if (TclListObjIsCanonical(objPtr)) {
|
||||
Tcl_ListObjLength(NULL, objPtr, &length);
|
||||
return length == 0;
|
||||
}
|
||||
@@ -570,20 +567,22 @@ Tcl_GetUniChar(
|
||||
if (index >= stringPtr->numChars) {
|
||||
return -1;
|
||||
}
|
||||
ch = stringPtr->unicode[index];
|
||||
ch = stringPtr->unicode[index];
|
||||
#if TCL_UTF_MAX <= 4
|
||||
/* See: bug [11ae2be95dac9417] */
|
||||
if ((ch&0xF800) == 0xD800) {
|
||||
if (ch&0x400) {
|
||||
if ((index > 0) && ((stringPtr->unicode[index-1]&0xFC00) == 0xD800)) {
|
||||
ch = -1; /* low surrogate preceded by high surrogate */
|
||||
}
|
||||
} else if ((++index < stringPtr->numChars)
|
||||
&& ((stringPtr->unicode[index]&0xFC00) == 0xDC00)) {
|
||||
/* high surrogate followed by low surrogate */
|
||||
ch = (((ch & 0x3FF) << 10) | (stringPtr->unicode[index] & 0x3FF)) + 0x10000;
|
||||
/* See: bug [11ae2be95dac9417] */
|
||||
if ((ch & 0xF800) == 0xD800) {
|
||||
if (ch & 0x400) {
|
||||
if ((index > 0)
|
||||
&& ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
|
||||
ch = -1; /* low surrogate preceded by high surrogate */
|
||||
}
|
||||
} else if ((++index < stringPtr->numChars)
|
||||
&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
|
||||
/* high surrogate followed by low surrogate */
|
||||
ch = (((ch & 0x3FF) << 10) |
|
||||
(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
return ch;
|
||||
}
|
||||
@@ -689,7 +688,8 @@ Tcl_GetRange(
|
||||
|
||||
if (first < 0) {
|
||||
first = 0;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Optimize the case where we're really dealing with a bytearray object
|
||||
* we don't need to convert to a string to perform the substring operation.
|
||||
@@ -697,13 +697,14 @@ Tcl_GetRange(
|
||||
|
||||
if (TclIsPureByteArray(objPtr)) {
|
||||
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
|
||||
|
||||
if (last >= length) {
|
||||
last = length - 1;
|
||||
}
|
||||
if (last < first) {
|
||||
return Tcl_NewObj();
|
||||
}
|
||||
return Tcl_NewByteArrayObj(bytes+first, last-first+1);
|
||||
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -742,24 +743,25 @@ Tcl_GetRange(
|
||||
FillUnicodeRep(objPtr);
|
||||
stringPtr = GET_STRING(objPtr);
|
||||
}
|
||||
if (last > stringPtr->numChars) {
|
||||
last = stringPtr->numChars;
|
||||
}
|
||||
if (last < first) {
|
||||
return Tcl_NewObj();
|
||||
}
|
||||
if (last > stringPtr->numChars) {
|
||||
last = stringPtr->numChars;
|
||||
}
|
||||
if (last < first) {
|
||||
return Tcl_NewObj();
|
||||
}
|
||||
#if TCL_UTF_MAX <= 4
|
||||
/* See: bug [11ae2be95dac9417] */
|
||||
if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
|
||||
&& ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
|
||||
++first;
|
||||
}
|
||||
if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
|
||||
&& ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
|
||||
++last;
|
||||
}
|
||||
/* See: bug [11ae2be95dac9417] */
|
||||
if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
|
||||
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
|
||||
++first;
|
||||
}
|
||||
if ((last + 1 < stringPtr->numChars)
|
||||
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
|
||||
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
|
||||
++last;
|
||||
}
|
||||
#endif
|
||||
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
|
||||
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
|
||||
}
|
||||
|
||||
/*
|
||||
@@ -1317,45 +1319,51 @@ Tcl_AppendObjToObj(
|
||||
/*
|
||||
* Handle append of one bytearray object to another as a special case.
|
||||
* Note that we only do this when the objects are pure so that the
|
||||
* bytearray faithfully represent the true value; Otherwise
|
||||
* appending the byte arrays together could lose information;
|
||||
* bytearray faithfully represent the true value; Otherwise appending the
|
||||
* byte arrays together could lose information;
|
||||
*/
|
||||
|
||||
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
|
||||
&& TclIsPureByteArray(appendObjPtr)) {
|
||||
|
||||
/*
|
||||
* 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.
|
||||
* 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.
|
||||
*
|
||||
* First, get the lengths.
|
||||
*/
|
||||
|
||||
/* Get lengths */
|
||||
int lengthSrc;
|
||||
|
||||
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
|
||||
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
|
||||
|
||||
/* Grow buffer enough for the append */
|
||||
/*
|
||||
* Grow buffer enough for the append.
|
||||
*/
|
||||
|
||||
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
|
||||
|
||||
/* Reset objPtr back to the original value */
|
||||
/*
|
||||
* Reset objPtr back to the original value.
|
||||
*/
|
||||
|
||||
Tcl_SetByteArrayLength(objPtr, length);
|
||||
|
||||
/*
|
||||
* Now do the append knowing that buffer growth cannot cause
|
||||
* any trouble.
|
||||
* Now do the append knowing that buffer growth cannot cause any
|
||||
* trouble.
|
||||
*/
|
||||
|
||||
TclAppendBytesToByteArray(objPtr,
|
||||
@@ -1403,6 +1411,7 @@ Tcl_AppendObjToObj(
|
||||
numChars = stringPtr->numChars;
|
||||
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
|
||||
String *appendStringPtr = GET_STRING(appendObjPtr);
|
||||
|
||||
appendNumChars = appendStringPtr->numChars;
|
||||
}
|
||||
|
||||
@@ -1660,6 +1669,43 @@ AppendUtfToUtfRep(
|
||||
objPtr->length = newLength;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_AppendStringsToObjVA --
|
||||
*
|
||||
* This function appends one or more null-terminated strings to an
|
||||
* object.
|
||||
*
|
||||
* Results:
|
||||
* None.
|
||||
*
|
||||
* Side effects:
|
||||
* The contents of all the string arguments are appended to the string
|
||||
* representation of objPtr.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
void
|
||||
Tcl_AppendStringsToObjVA(
|
||||
Tcl_Obj *objPtr, /* Points to the object to append to. */
|
||||
va_list argList) /* Variable argument list. */
|
||||
{
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
|
||||
}
|
||||
|
||||
while (1) {
|
||||
const char *bytes = va_arg(argList, char *);
|
||||
|
||||
if (bytes == NULL) {
|
||||
break;
|
||||
}
|
||||
Tcl_AppendToObj(objPtr, bytes, -1);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
@@ -1686,18 +1732,7 @@ Tcl_AppendStringsToObj(
|
||||
va_list argList;
|
||||
|
||||
va_start(argList, objPtr);
|
||||
if (Tcl_IsShared(objPtr)) {
|
||||
Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
|
||||
}
|
||||
|
||||
while (1) {
|
||||
const char *bytes = va_arg(argList, char *);
|
||||
|
||||
if (bytes == NULL) {
|
||||
break;
|
||||
}
|
||||
Tcl_AppendToObj(objPtr, bytes, -1);
|
||||
}
|
||||
Tcl_AppendStringsToObjVA(objPtr, argList);
|
||||
va_end(argList);
|
||||
}
|
||||
|
||||
@@ -1962,7 +1997,8 @@ Tcl_AppendFormatToObj(
|
||||
format += step;
|
||||
step = TclUtfToUniChar(format, &ch);
|
||||
}
|
||||
} else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j') || (ch == 'L')) {
|
||||
} else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j')
|
||||
|| (ch == 'L')) {
|
||||
format += step;
|
||||
step = TclUtfToUniChar(format, &ch);
|
||||
useBig = 1;
|
||||
@@ -2123,6 +2159,14 @@ Tcl_AppendFormatToObj(
|
||||
Tcl_AppendToObj(segment, "0b", 2);
|
||||
segmentLimit -= 2;
|
||||
break;
|
||||
#if TCL_MAJOR_VERSION < 9
|
||||
case 'd':
|
||||
if (gotZero) {
|
||||
Tcl_AppendToObj(segment, "0d", 2);
|
||||
segmentLimit -= 2;
|
||||
}
|
||||
break;
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2479,7 +2523,7 @@ Tcl_AppendFormatToObj(
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_Format--
|
||||
* Tcl_Format --
|
||||
*
|
||||
* Results:
|
||||
* A refcount zero Tcl_Obj.
|
||||
@@ -2870,7 +2914,10 @@ TclStringRepeat(
|
||||
Tcl_GetByteArrayFromObj(objResultPtr, NULL),
|
||||
(count - done) * length);
|
||||
} else if (unichar) {
|
||||
/* Efficiently produce a pure Tcl_UniChar array result */
|
||||
/*
|
||||
* Efficiently produce a pure Tcl_UniChar array result.
|
||||
*/
|
||||
|
||||
if (!inPlace || Tcl_IsShared(objPtr)) {
|
||||
objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
|
||||
} else {
|
||||
@@ -2896,7 +2943,10 @@ TclStringRepeat(
|
||||
Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
|
||||
(count - done) * length);
|
||||
} else {
|
||||
/* Efficiently concatenate string reps */
|
||||
/*
|
||||
* Efficiently concatenate string reps.
|
||||
*/
|
||||
|
||||
if (!inPlace || Tcl_IsShared(objPtr)) {
|
||||
objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
|
||||
} else {
|
||||
@@ -2980,9 +3030,10 @@ TclStringCat(
|
||||
/* Value has a string rep. */
|
||||
if (objPtr->length) {
|
||||
/*
|
||||
* Non-empty string rep. Not a pure bytearray, so we
|
||||
* won't create a pure bytearray
|
||||
* Non-empty string rep. Not a pure bytearray, so we won't
|
||||
* create a pure bytearray.
|
||||
*/
|
||||
|
||||
binary = 0;
|
||||
if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
|
||||
/* Prevent shimmer of non-string types. */
|
||||
@@ -3003,8 +3054,12 @@ TclStringCat(
|
||||
} while (--oc && (binary || allowUniChar));
|
||||
|
||||
if (binary) {
|
||||
/* Result will be pure byte array. Pre-size it */
|
||||
ov = objv; oc = objc;
|
||||
/*
|
||||
* Result will be pure byte array. Pre-size it
|
||||
*/
|
||||
|
||||
ov = objv;
|
||||
oc = objc;
|
||||
do {
|
||||
Tcl_Obj *objPtr = *ov++;
|
||||
|
||||
@@ -3024,8 +3079,12 @@ TclStringCat(
|
||||
}
|
||||
} while (--oc);
|
||||
} else if (allowUniChar && requestUniChar) {
|
||||
/* Result will be pure Tcl_UniChar array. Pre-size it. */
|
||||
ov = objv; oc = objc;
|
||||
/*
|
||||
* Result will be pure Tcl_UniChar array. Pre-size it.
|
||||
*/
|
||||
|
||||
ov = objv;
|
||||
oc = objc;
|
||||
do {
|
||||
Tcl_Obj *objPtr = *ov++;
|
||||
|
||||
@@ -3070,9 +3129,9 @@ TclStringCat(
|
||||
} while (--oc && (length == 0) && (pendingPtr == NULL));
|
||||
|
||||
/*
|
||||
* Either we found a possibly non-empty value, and we
|
||||
* remember this index as the first and last such value so
|
||||
* far seen, or (oc == 0) and all values are known empty,
|
||||
* Either we found a possibly non-empty value, and we remember
|
||||
* this index as the first and last such value so far seen,
|
||||
* or (oc == 0) and all values are known empty,
|
||||
* so first = last = objc - 1 signals the right quick return.
|
||||
*/
|
||||
|
||||
@@ -3084,10 +3143,9 @@ TclStringCat(
|
||||
/* assert ( pendingPtr != NULL ) */
|
||||
|
||||
/*
|
||||
* There's a pending value followed by more values.
|
||||
* Loop over remaining values generating strings until
|
||||
* a non-empty value is found, or the pending value gets
|
||||
* its string generated.
|
||||
* There's a pending value followed by more values. Loop over
|
||||
* remaining values generating strings until a non-empty value
|
||||
* is found, or the pending value gets its string generated.
|
||||
*/
|
||||
|
||||
do {
|
||||
@@ -3143,10 +3201,10 @@ TclStringCat(
|
||||
unsigned char *dst;
|
||||
|
||||
/*
|
||||
* Broken interface! Byte array value routines offer no way
|
||||
* to handle failure to allocate enough space. Following
|
||||
* stanza may panic.
|
||||
* Broken interface! Byte array value routines offer no way to handle
|
||||
* failure to allocate enough space. Following stanza may panic.
|
||||
*/
|
||||
|
||||
if (inPlace && !Tcl_IsShared(*objv)) {
|
||||
int start;
|
||||
|
||||
@@ -3261,6 +3319,7 @@ TclStringCat(
|
||||
if ((objPtr->bytes == NULL) || (objPtr->length)) {
|
||||
int more;
|
||||
char *src = Tcl_GetStringFromObj(objPtr, &more);
|
||||
|
||||
memcpy(dst, src, (size_t) more);
|
||||
dst += more;
|
||||
}
|
||||
@@ -3279,6 +3338,187 @@ TclStringCat(
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
* TclStringCmp --
|
||||
* Compare two Tcl_Obj values as strings.
|
||||
*
|
||||
* Results:
|
||||
* Like memcmp, return -1, 0, or 1.
|
||||
*
|
||||
* Side effects:
|
||||
* String representations may be generated. Internal representation may
|
||||
* be changed.
|
||||
*
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
int TclStringCmp(
|
||||
Tcl_Obj *value1Ptr,
|
||||
Tcl_Obj *value2Ptr,
|
||||
int checkEq, /* comparison is only for equality */
|
||||
int nocase, /* comparison is not case sensitive */
|
||||
int reqlength) /* requested length */
|
||||
{
|
||||
char *s1, *s2;
|
||||
int empty, length, match, s1len, s2len;
|
||||
memCmpFn_t memCmpFn;
|
||||
|
||||
if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
|
||||
/*
|
||||
* Always match at 0 chars of if it is the same obj.
|
||||
*/
|
||||
match = 0;
|
||||
} else {
|
||||
|
||||
if (!nocase && TclIsPureByteArray(value1Ptr)
|
||||
&& TclIsPureByteArray(value2Ptr)) {
|
||||
/*
|
||||
* Use binary versions of comparisons since that won't cause undue
|
||||
* type conversions and it is much faster. Only do this if we're
|
||||
* case-sensitive (which is all that really makes sense with byte
|
||||
* arrays anyway, and we have no memcasecmp() for some reason... :^)
|
||||
*/
|
||||
|
||||
s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
|
||||
s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = memcmp;
|
||||
} else if ((value1Ptr->typePtr == &tclStringType)
|
||||
&& (value2Ptr->typePtr == &tclStringType)) {
|
||||
/*
|
||||
* Do a unicode-specific comparison if both of the args are of
|
||||
* String type. If the char length == byte length, we can do a
|
||||
* memcmp. In benchmark testing this proved the most efficient
|
||||
* check between the unicode and string comparison operations.
|
||||
*/
|
||||
|
||||
if (nocase) {
|
||||
s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
|
||||
s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
|
||||
memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
|
||||
} else {
|
||||
s1len = Tcl_GetCharLength(value1Ptr);
|
||||
s2len = Tcl_GetCharLength(value2Ptr);
|
||||
if ((s1len == value1Ptr->length)
|
||||
&& (value1Ptr->bytes != NULL)
|
||||
&& (s2len == value2Ptr->length)
|
||||
&& (value2Ptr->bytes != NULL)) {
|
||||
s1 = value1Ptr->bytes;
|
||||
s2 = value2Ptr->bytes;
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
s1 = (char *) Tcl_GetUnicode(value1Ptr);
|
||||
s2 = (char *) Tcl_GetUnicode(value2Ptr);
|
||||
if (
|
||||
#ifdef WORDS_BIGENDIAN
|
||||
1
|
||||
#else
|
||||
checkEq
|
||||
#endif
|
||||
) {
|
||||
memCmpFn = memcmp;
|
||||
s1len *= sizeof(Tcl_UniChar);
|
||||
s2len *= sizeof(Tcl_UniChar);
|
||||
} else {
|
||||
memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
|
||||
}
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if ((empty = TclCheckEmptyString(value1Ptr)) > 0) {
|
||||
switch (TclCheckEmptyString(value2Ptr)) {
|
||||
case -1:
|
||||
s1 = 0;
|
||||
s1len = 0;
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
break;
|
||||
case 0:
|
||||
match = -1;
|
||||
goto matchdone;
|
||||
case 1:
|
||||
default: /* avoid warn: `s2` may be used uninitialized */
|
||||
match = 0;
|
||||
goto matchdone;
|
||||
}
|
||||
} else if (TclCheckEmptyString(value2Ptr) > 0) {
|
||||
switch (empty) {
|
||||
case -1:
|
||||
s2 = 0;
|
||||
s2len = 0;
|
||||
s1 = TclGetStringFromObj(value1Ptr, &s1len);
|
||||
break;
|
||||
case 0:
|
||||
match = 1;
|
||||
goto matchdone;
|
||||
case 1:
|
||||
default: /* avoid warn: `s1` may be used uninitialized */
|
||||
match = 0;
|
||||
goto matchdone;
|
||||
}
|
||||
} else {
|
||||
s1 = TclGetStringFromObj(value1Ptr, &s1len);
|
||||
s2 = TclGetStringFromObj(value2Ptr, &s2len);
|
||||
}
|
||||
if (!nocase && checkEq) {
|
||||
/*
|
||||
* When we have equal-length we can check only for
|
||||
* (in)equality. We can use memcmp in all (n)eq cases because
|
||||
* we don't need to worry about lexical LE/BE variance.
|
||||
*/
|
||||
|
||||
memCmpFn = memcmp;
|
||||
} else {
|
||||
/*
|
||||
* As a catch-all we will work with UTF-8. We cannot use
|
||||
* memcmp() as that is unsafe with any string containing NUL
|
||||
* (\xC0\x80 in Tcl's utf rep). We can use the more efficient
|
||||
* TclpUtfNcmp2 if we are case-sensitive and no specific
|
||||
* length was requested.
|
||||
*/
|
||||
|
||||
if ((reqlength < 0) && !nocase) {
|
||||
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
|
||||
} else {
|
||||
s1len = Tcl_NumUtfChars(s1, s1len);
|
||||
s2len = Tcl_NumUtfChars(s2, s2len);
|
||||
memCmpFn = (memCmpFn_t)
|
||||
(nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
length = (s1len < s2len) ? s1len : s2len;
|
||||
if (reqlength > 0 && reqlength < length) {
|
||||
length = reqlength;
|
||||
} else if (reqlength < 0) {
|
||||
/*
|
||||
* The requested length is negative, so we ignore it by setting it
|
||||
* to length + 1 so we correct the match var.
|
||||
*/
|
||||
|
||||
reqlength = length + 1;
|
||||
}
|
||||
|
||||
if (checkEq && (s1len != s2len)) {
|
||||
match = 1; /* This will be reversed below. */
|
||||
} else {
|
||||
/*
|
||||
* The comparison function should compare up to the minimum byte
|
||||
* length only.
|
||||
*/
|
||||
|
||||
match = memCmpFn(s1, s2, (size_t) length);
|
||||
}
|
||||
if ((match == 0) && (reqlength > length)) {
|
||||
match = s1len - s2len;
|
||||
}
|
||||
match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
|
||||
}
|
||||
matchdone:
|
||||
return match;
|
||||
}
|
||||
|
||||
/*
|
||||
*---------------------------------------------------------------------------
|
||||
*
|
||||
@@ -3473,18 +3713,20 @@ static void
|
||||
ReverseBytes(
|
||||
unsigned char *to, /* Copy bytes into here... */
|
||||
unsigned char *from, /* ...from here... */
|
||||
int count) /* Until this many are copied, */
|
||||
int count) /* Until this many are copied, */
|
||||
/* reversing as you go. */
|
||||
{
|
||||
unsigned char *src = from + count;
|
||||
|
||||
if (to == from) {
|
||||
/* Reversing in place */
|
||||
while (--src > to) {
|
||||
unsigned char c = *src;
|
||||
|
||||
*src = *to;
|
||||
*to++ = c;
|
||||
}
|
||||
} else {
|
||||
} else {
|
||||
while (--src >= from) {
|
||||
*to++ = *src;
|
||||
}
|
||||
@@ -3533,7 +3775,10 @@ TclStringReverse(
|
||||
*to++ = *src;
|
||||
}
|
||||
} else {
|
||||
/* Reversing in place */
|
||||
/*
|
||||
* Reversing in place.
|
||||
*/
|
||||
|
||||
while (--src > from) {
|
||||
ch = *src;
|
||||
*src = *from;
|
||||
@@ -3557,20 +3802,22 @@ TclStringReverse(
|
||||
/*
|
||||
* Either numChars == -1 and we don't know how many chars are
|
||||
* represented by objPtr->bytes and we need Pass 1 just in case,
|
||||
* or numChars >= 0 and we know we have fewer chars than bytes,
|
||||
* so we know there's a multibyte character needing Pass 1.
|
||||
* or numChars >= 0 and we know we have fewer chars than bytes, so
|
||||
* we know there's a multibyte character needing Pass 1.
|
||||
*
|
||||
* Pass 1. Reverse the bytes of each multi-byte character.
|
||||
*/
|
||||
|
||||
int charCount = 0;
|
||||
int bytesLeft = numBytes;
|
||||
|
||||
while (bytesLeft) {
|
||||
/*
|
||||
* NOTE: We know that the from buffer is NUL-terminated.
|
||||
* It's part of the contract for objPtr->bytes values.
|
||||
* Thus, we can skip calling Tcl_UtfCharComplete() here.
|
||||
* NOTE: We know that the from buffer is NUL-terminated. It's
|
||||
* part of the contract for objPtr->bytes values. Thus, we can
|
||||
* skip calling Tcl_UtfCharComplete() here.
|
||||
*/
|
||||
|
||||
int bytesInChar = TclUtfToUniChar(from, &ch);
|
||||
|
||||
ReverseBytes((unsigned char *)to, (unsigned char *)from,
|
||||
@@ -3600,19 +3847,18 @@ TclStringReverse(
|
||||
*
|
||||
* The result is a concatenation of a prefix from objPtr, characters
|
||||
* 0 through first-1, the insertPtr string value, and a suffix from
|
||||
* objPtr, characters from first + count to the end. The effect is
|
||||
* as if the inner substring of characters first through first+count-1
|
||||
* are removed and replaced with insertPtr.
|
||||
* If insertPtr is NULL, it is treated as an empty string.
|
||||
* When passed the flag TCL_STRING_IN_PLACE, this routine will try
|
||||
* to do the work within objPtr, so long as no sharing forbids it.
|
||||
* Without that request, or as needed, a new Tcl value will be allocated
|
||||
* to be the result.
|
||||
* objPtr, characters from first + count to the end. The effect is as if
|
||||
* the inner substring of characters first through first+count-1 are
|
||||
* removed and replaced with insertPtr. If insertPtr is NULL, it is
|
||||
* treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,
|
||||
* this routine will try to do the work within objPtr, so long as no
|
||||
* sharing forbids it. Without that request, or as needed, a new Tcl
|
||||
* value will be allocated to be the result.
|
||||
*
|
||||
* Results:
|
||||
* A Tcl value that is the result of the substring replacement.
|
||||
* May return NULL in case of an error. When NULL is returned and
|
||||
* interp is non-NULL, error information is left in interp
|
||||
* A Tcl value that is the result of the substring replacement. May
|
||||
* return NULL in case of an error. When NULL is returned and interp is
|
||||
* non-NULL, error information is left in interp
|
||||
*
|
||||
*---------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
+294
-80
@@ -40,24 +40,125 @@
|
||||
#undef Tcl_CreateHashEntry
|
||||
#undef Tcl_Panic
|
||||
#undef Tcl_FindExecutable
|
||||
#undef Tcl_SetPanicProc
|
||||
#undef TclpGetPid
|
||||
#undef TclSockMinimumBuffers
|
||||
#undef Tcl_SetIntObj
|
||||
#undef Tcl_SetLongObj
|
||||
#undef TclpInetNtoa
|
||||
#undef TclWinGetServByName
|
||||
#undef TclWinGetSockOpt
|
||||
#undef TclWinSetSockOpt
|
||||
#undef TclWinNToHS
|
||||
|
||||
#ifdef _WIN32
|
||||
# define TclUnixWaitForFile 0
|
||||
# define TclUnixCopyFile 0
|
||||
# define TclUnixOpenTemporaryFile 0
|
||||
# define TclpIsAtty 0
|
||||
#elif defined(__CYGWIN__)
|
||||
# define TclpIsAtty TclPlatIsAtty
|
||||
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
|
||||
#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
|
||||
# define TclSockMinimumBuffersOld 0
|
||||
#else
|
||||
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
|
||||
static int TclSockMinimumBuffersOld(int sock, int size)
|
||||
{
|
||||
return TclSockMinimumBuffers(INT2PTR(sock), size);
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
|
||||
# define TclSetStartupScriptPath 0
|
||||
# define TclGetStartupScriptPath 0
|
||||
# define TclSetStartupScriptFileName 0
|
||||
# define TclGetStartupScriptFileName 0
|
||||
# define TclPrecTraceProc 0
|
||||
# define TclpInetNtoa 0
|
||||
# define TclWinGetServByName 0
|
||||
# define TclWinGetSockOpt 0
|
||||
# define TclWinSetSockOpt 0
|
||||
# define TclWinNToHS 0
|
||||
# define TclWinGetPlatformId 0
|
||||
# define TclWinResetInterfaces 0
|
||||
# define TclWinSetInterfaces 0
|
||||
# define TclWinGetPlatformId 0
|
||||
# define TclBNInitBignumFromWideUInt 0
|
||||
# define TclBNInitBignumFromWideInt 0
|
||||
# define TclBNInitBignumFromLong 0
|
||||
# define Tcl_Backslash 0
|
||||
# define Tcl_GetDefaultEncodingDir 0
|
||||
# define Tcl_SetDefaultEncodingDir 0
|
||||
# define Tcl_EvalTokens 0
|
||||
# define Tcl_CreateMathFunc 0
|
||||
# define Tcl_GetMathFuncInfo 0
|
||||
# define Tcl_ListMathFuncs 0
|
||||
#else
|
||||
#define TclSetStartupScriptPath setStartupScriptPath
|
||||
static void TclSetStartupScriptPath(Tcl_Obj *path)
|
||||
{
|
||||
Tcl_SetStartupScript(path, NULL);
|
||||
}
|
||||
#define TclGetStartupScriptPath getStartupScriptPath
|
||||
static Tcl_Obj *TclGetStartupScriptPath(void)
|
||||
{
|
||||
return Tcl_GetStartupScript(NULL);
|
||||
}
|
||||
#define TclSetStartupScriptFileName setStartupScriptFileName
|
||||
static void TclSetStartupScriptFileName(
|
||||
const char *fileName)
|
||||
{
|
||||
Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL);
|
||||
}
|
||||
#define TclGetStartupScriptFileName getStartupScriptFileName
|
||||
static const char *TclGetStartupScriptFileName(void)
|
||||
{
|
||||
Tcl_Obj *path = Tcl_GetStartupScript(NULL);
|
||||
if (path == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
return Tcl_GetString(path);
|
||||
}
|
||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||
#undef TclWinNToHS
|
||||
#undef TclWinGetPlatformId
|
||||
#undef TclWinResetInterfaces
|
||||
#undef TclWinSetInterfaces
|
||||
static void
|
||||
doNothing(void)
|
||||
{
|
||||
/* dummy implementation, no need to do anything */
|
||||
}
|
||||
#define TclWinNToHS winNToHS
|
||||
static unsigned short TclWinNToHS(unsigned short ns) {
|
||||
return ntohs(ns);
|
||||
}
|
||||
#define TclWinGetPlatformId winGetPlatformId
|
||||
static int
|
||||
TclWinGetPlatformId(void)
|
||||
{
|
||||
return 2; /* VER_PLATFORM_WIN32_NT */;
|
||||
}
|
||||
#define TclWinResetInterfaces doNothing
|
||||
#define TclWinSetInterfaces (void (*) (int)) doNothing
|
||||
#endif
|
||||
# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
|
||||
# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
|
||||
# define TclBNInitBignumFromLong TclInitBignumFromLong
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
#ifdef _WIN32
|
||||
# define TclUnixWaitForFile 0
|
||||
# define TclUnixCopyFile 0
|
||||
# define TclUnixOpenTemporaryFile 0
|
||||
# define TclpReaddir 0
|
||||
# define TclpIsAtty 0
|
||||
#elif defined(__CYGWIN__)
|
||||
# define TclpIsAtty TclPlatIsAtty
|
||||
#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
|
||||
static void
|
||||
doNothing(void)
|
||||
{
|
||||
/* dummy implementation, no need to do anything */
|
||||
}
|
||||
#endif
|
||||
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
|
||||
# define TclWinFlushDirtyChannels doNothing
|
||||
|
||||
static int
|
||||
TclpIsAtty(int fd)
|
||||
{
|
||||
@@ -72,6 +173,31 @@ void *TclWinGetTclInstance()
|
||||
return hInstance;
|
||||
}
|
||||
|
||||
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
|
||||
#define TclWinSetSockOpt winSetSockOpt
|
||||
static int
|
||||
TclWinSetSockOpt(SOCKET s, int level, int optname,
|
||||
const char *optval, int optlen)
|
||||
{
|
||||
return setsockopt((int) s, level, optname, optval, optlen);
|
||||
}
|
||||
|
||||
#define TclWinGetSockOpt winGetSockOpt
|
||||
static int
|
||||
TclWinGetSockOpt(SOCKET s, int level, int optname,
|
||||
char *optval, int *optlen)
|
||||
{
|
||||
return getsockopt((int) s, level, optname, optval, optlen);
|
||||
}
|
||||
|
||||
#define TclWinGetServByName winGetServByName
|
||||
static struct servent *
|
||||
TclWinGetServByName(const char *name, const char *proto)
|
||||
{
|
||||
return getservbyname(name, proto);
|
||||
}
|
||||
#endif /* TCL_NO_DEPRECATED */
|
||||
|
||||
#define TclWinNoBackslash winNoBackslash
|
||||
static char *
|
||||
TclWinNoBackslash(char *path)
|
||||
@@ -194,6 +320,8 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
|
||||
#endif /* __CYGWIN__ */
|
||||
|
||||
#if defined(TCL_NO_DEPRECATED)
|
||||
# define Tcl_SeekOld 0
|
||||
# define Tcl_TellOld 0
|
||||
# undef Tcl_SetBooleanObj
|
||||
# define Tcl_SetBooleanObj 0
|
||||
# undef Tcl_PkgPresent
|
||||
@@ -239,6 +367,83 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
|
||||
# define Tcl_DiscardResult 0
|
||||
# undef Tcl_SetResult
|
||||
# define Tcl_SetResult 0
|
||||
# undef Tcl_EvalObj
|
||||
# define Tcl_EvalObj 0
|
||||
# undef Tcl_GlobalEvalObj
|
||||
# define Tcl_GlobalEvalObj 0
|
||||
# define TclBackgroundException 0
|
||||
# undef TclpReaddir
|
||||
# define TclpReaddir 0
|
||||
# define TclSetStartupScript 0
|
||||
# define TclGetStartupScript 0
|
||||
# define TclCreateNamespace 0
|
||||
# define TclDeleteNamespace 0
|
||||
# define TclAppendExportList 0
|
||||
# define TclExport 0
|
||||
# define TclImport 0
|
||||
# define TclForgetImport 0
|
||||
# define TclGetCurrentNamespace_ 0
|
||||
# define TclGetGlobalNamespace_ 0
|
||||
# define TclFindNamespace 0
|
||||
# define TclFindCommand 0
|
||||
# define TclGetCommandFromObj 0
|
||||
# define TclGetCommandFullName 0
|
||||
# define TclCopyChannelOld 0
|
||||
# define Tcl_AppendResultVA 0
|
||||
# define Tcl_AppendStringsToObjVA 0
|
||||
# define Tcl_SetErrorCodeVA 0
|
||||
# define Tcl_PanicVA 0
|
||||
# define Tcl_VarEvalVA 0
|
||||
# undef TclpGetDate
|
||||
# define TclpGetDate 0
|
||||
# undef TclpLocaltime
|
||||
# define TclpLocaltime 0
|
||||
# undef TclpGmtime
|
||||
# define TclpGmtime 0
|
||||
# define TclpLocaltime_unix 0
|
||||
# define TclpGmtime_unix 0
|
||||
#else /* TCL_NO_DEPRECATED */
|
||||
# define Tcl_SeekOld seekOld
|
||||
# define Tcl_TellOld tellOld
|
||||
# define TclBackgroundException Tcl_BackgroundException
|
||||
# define TclSetStartupScript Tcl_SetStartupScript
|
||||
# define TclGetStartupScript Tcl_GetStartupScript
|
||||
# define TclCreateNamespace Tcl_CreateNamespace
|
||||
# define TclDeleteNamespace Tcl_DeleteNamespace
|
||||
# define TclAppendExportList Tcl_AppendExportList
|
||||
# define TclExport Tcl_Export
|
||||
# define TclImport Tcl_Import
|
||||
# define TclForgetImport Tcl_ForgetImport
|
||||
# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
|
||||
# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
|
||||
# define TclFindNamespace Tcl_FindNamespace
|
||||
# define TclFindCommand Tcl_FindCommand
|
||||
# define TclGetCommandFromObj Tcl_GetCommandFromObj
|
||||
# define TclGetCommandFullName Tcl_GetCommandFullName
|
||||
# define TclpLocaltime_unix TclpLocaltime
|
||||
# define TclpGmtime_unix TclpGmtime
|
||||
|
||||
static int
|
||||
seekOld(
|
||||
Tcl_Channel chan, /* The channel on which to seek. */
|
||||
int offset, /* Offset to seek to. */
|
||||
int mode) /* Relative to which location to seek? */
|
||||
{
|
||||
Tcl_WideInt wOffset, wResult;
|
||||
|
||||
wOffset = Tcl_LongAsWide((long) offset);
|
||||
wResult = Tcl_Seek(chan, wOffset, mode);
|
||||
return (int) Tcl_WideAsLong(wResult);
|
||||
}
|
||||
|
||||
static int
|
||||
tellOld(
|
||||
Tcl_Channel chan) /* The channel to return pos for. */
|
||||
{
|
||||
Tcl_WideInt wResult = Tcl_Tell(chan);
|
||||
|
||||
return (int) Tcl_WideAsLong(wResult);
|
||||
}
|
||||
#endif /* !TCL_NO_DEPRECATED */
|
||||
|
||||
/*
|
||||
@@ -250,6 +455,15 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
|
||||
MODULE_SCOPE const TclStubs tclStubs;
|
||||
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
|
||||
|
||||
#ifdef __GNUC__
|
||||
/*
|
||||
* The rest of this file shouldn't warn about deprecated functions; they're
|
||||
* there because we intend them to be so and know that this file is OK to
|
||||
* touch those fields.
|
||||
*/
|
||||
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
|
||||
#endif
|
||||
|
||||
/* !BEGIN!: Do not edit below this line. */
|
||||
|
||||
static const TclIntStubs tclIntStubs = {
|
||||
@@ -263,7 +477,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclCleanupChildren, /* 5 */
|
||||
TclCleanupCommand, /* 6 */
|
||||
TclCopyAndCollapse, /* 7 */
|
||||
0, /* 8 */
|
||||
TclCopyChannelOld, /* 8 */
|
||||
TclCreatePipeline, /* 9 */
|
||||
TclCreateProc, /* 10 */
|
||||
TclDeleteCompiledLocalVars, /* 11 */
|
||||
@@ -332,7 +546,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclpFree, /* 74 */
|
||||
TclpGetClicks, /* 75 */
|
||||
TclpGetSeconds, /* 76 */
|
||||
0, /* 77 */
|
||||
TclpGetTime, /* 77 */
|
||||
0, /* 78 */
|
||||
0, /* 79 */
|
||||
0, /* 80 */
|
||||
@@ -343,7 +557,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
0, /* 85 */
|
||||
0, /* 86 */
|
||||
0, /* 87 */
|
||||
0, /* 88 */
|
||||
TclPrecTraceProc, /* 88 */
|
||||
TclPreventAliasLoop, /* 89 */
|
||||
0, /* 90 */
|
||||
TclProcCleanupProc, /* 91 */
|
||||
@@ -359,7 +573,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclSetPreInitScript, /* 101 */
|
||||
TclSetupEnv, /* 102 */
|
||||
TclSockGetPort, /* 103 */
|
||||
0, /* 104 */
|
||||
TclSockMinimumBuffersOld, /* 104 */
|
||||
0, /* 105 */
|
||||
0, /* 106 */
|
||||
0, /* 107 */
|
||||
@@ -367,28 +581,28 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclUpdateReturnInfo, /* 109 */
|
||||
TclSockMinimumBuffers, /* 110 */
|
||||
Tcl_AddInterpResolvers, /* 111 */
|
||||
0, /* 112 */
|
||||
0, /* 113 */
|
||||
0, /* 114 */
|
||||
0, /* 115 */
|
||||
0, /* 116 */
|
||||
0, /* 117 */
|
||||
TclAppendExportList, /* 112 */
|
||||
TclCreateNamespace, /* 113 */
|
||||
TclDeleteNamespace, /* 114 */
|
||||
TclExport, /* 115 */
|
||||
TclFindCommand, /* 116 */
|
||||
TclFindNamespace, /* 117 */
|
||||
Tcl_GetInterpResolvers, /* 118 */
|
||||
Tcl_GetNamespaceResolvers, /* 119 */
|
||||
Tcl_FindNamespaceVar, /* 120 */
|
||||
0, /* 121 */
|
||||
0, /* 122 */
|
||||
0, /* 123 */
|
||||
0, /* 124 */
|
||||
0, /* 125 */
|
||||
TclForgetImport, /* 121 */
|
||||
TclGetCommandFromObj, /* 122 */
|
||||
TclGetCommandFullName, /* 123 */
|
||||
TclGetCurrentNamespace_, /* 124 */
|
||||
TclGetGlobalNamespace_, /* 125 */
|
||||
Tcl_GetVariableFullName, /* 126 */
|
||||
0, /* 127 */
|
||||
TclImport, /* 127 */
|
||||
Tcl_PopCallFrame, /* 128 */
|
||||
Tcl_PushCallFrame, /* 129 */
|
||||
Tcl_RemoveInterpResolvers, /* 130 */
|
||||
Tcl_SetNamespaceResolvers, /* 131 */
|
||||
TclpHasSockets, /* 132 */
|
||||
0, /* 133 */
|
||||
TclpGetDate, /* 133 */
|
||||
0, /* 134 */
|
||||
0, /* 135 */
|
||||
0, /* 136 */
|
||||
@@ -413,8 +627,8 @@ static const TclIntStubs tclIntStubs = {
|
||||
0, /* 155 */
|
||||
TclRegError, /* 156 */
|
||||
TclVarTraceExists, /* 157 */
|
||||
0, /* 158 */
|
||||
0, /* 159 */
|
||||
TclSetStartupScriptFileName, /* 158 */
|
||||
TclGetStartupScriptFileName, /* 159 */
|
||||
0, /* 160 */
|
||||
TclChannelTransform, /* 161 */
|
||||
TclChannelEventScriptInvoker, /* 162 */
|
||||
@@ -422,8 +636,8 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclExpandCodeArray, /* 164 */
|
||||
TclpSetInitialEncodings, /* 165 */
|
||||
TclListObjSetElement, /* 166 */
|
||||
0, /* 167 */
|
||||
0, /* 168 */
|
||||
TclSetStartupScriptPath, /* 167 */
|
||||
TclGetStartupScriptPath, /* 168 */
|
||||
TclpUtfNcmp2, /* 169 */
|
||||
TclCheckInterpTraces, /* 170 */
|
||||
TclCheckExecutionTraces, /* 171 */
|
||||
@@ -433,12 +647,12 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclCallVarTraces, /* 175 */
|
||||
TclCleanupVar, /* 176 */
|
||||
TclVarErrMsg, /* 177 */
|
||||
0, /* 178 */
|
||||
0, /* 179 */
|
||||
TclSetStartupScript, /* 178 */
|
||||
TclGetStartupScript, /* 179 */
|
||||
0, /* 180 */
|
||||
0, /* 181 */
|
||||
0, /* 182 */
|
||||
0, /* 183 */
|
||||
TclpLocaltime, /* 182 */
|
||||
TclpGmtime, /* 183 */
|
||||
0, /* 184 */
|
||||
0, /* 185 */
|
||||
0, /* 186 */
|
||||
@@ -491,7 +705,7 @@ static const TclIntStubs tclIntStubs = {
|
||||
TclGetSrcInfoForPc, /* 233 */
|
||||
TclVarHashCreateVar, /* 234 */
|
||||
TclInitVarHashTable, /* 235 */
|
||||
0, /* 236 */
|
||||
TclBackgroundException, /* 236 */
|
||||
TclResetCancellation, /* 237 */
|
||||
TclNRInterpProc, /* 238 */
|
||||
TclNRInterpProcCore, /* 239 */
|
||||
@@ -528,10 +742,10 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TclpOpenFile, /* 7 */
|
||||
TclUnixWaitForFile, /* 8 */
|
||||
TclpCreateTempFile, /* 9 */
|
||||
0, /* 10 */
|
||||
0, /* 11 */
|
||||
0, /* 12 */
|
||||
0, /* 13 */
|
||||
TclpReaddir, /* 10 */
|
||||
TclpLocaltime_unix, /* 11 */
|
||||
TclpGmtime_unix, /* 12 */
|
||||
TclpInetNtoa, /* 13 */
|
||||
TclUnixCopyFile, /* 14 */
|
||||
0, /* 15 */
|
||||
0, /* 16 */
|
||||
@@ -552,16 +766,16 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
#endif /* UNIX */
|
||||
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
|
||||
TclWinConvertError, /* 0 */
|
||||
0, /* 1 */
|
||||
0, /* 2 */
|
||||
0, /* 3 */
|
||||
TclWinConvertWSAError, /* 1 */
|
||||
TclWinGetServByName, /* 2 */
|
||||
TclWinGetSockOpt, /* 3 */
|
||||
TclWinGetTclInstance, /* 4 */
|
||||
TclUnixWaitForFile, /* 5 */
|
||||
0, /* 6 */
|
||||
0, /* 7 */
|
||||
TclWinNToHS, /* 6 */
|
||||
TclWinSetSockOpt, /* 7 */
|
||||
TclpGetPid, /* 8 */
|
||||
0, /* 9 */
|
||||
0, /* 10 */
|
||||
TclWinGetPlatformId, /* 9 */
|
||||
TclpReaddir, /* 10 */
|
||||
TclGetAndDetachPids, /* 11 */
|
||||
TclpCloseFile, /* 12 */
|
||||
TclpCreateCommandChannel, /* 13 */
|
||||
@@ -572,14 +786,14 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TclpMakeFile, /* 18 */
|
||||
TclpOpenFile, /* 19 */
|
||||
TclWinAddProcess, /* 20 */
|
||||
0, /* 21 */
|
||||
TclpInetNtoa, /* 21 */
|
||||
TclpCreateTempFile, /* 22 */
|
||||
0, /* 23 */
|
||||
TclWinNoBackslash, /* 24 */
|
||||
0, /* 25 */
|
||||
0, /* 26 */
|
||||
TclWinSetInterfaces, /* 26 */
|
||||
TclWinFlushDirtyChannels, /* 27 */
|
||||
0, /* 28 */
|
||||
TclWinResetInterfaces, /* 28 */
|
||||
TclWinCPUID, /* 29 */
|
||||
TclUnixOpenTemporaryFile, /* 30 */
|
||||
#endif /* WIN */
|
||||
@@ -594,10 +808,10 @@ static const TclIntPlatStubs tclIntPlatStubs = {
|
||||
TclpOpenFile, /* 7 */
|
||||
TclUnixWaitForFile, /* 8 */
|
||||
TclpCreateTempFile, /* 9 */
|
||||
0, /* 10 */
|
||||
0, /* 11 */
|
||||
0, /* 12 */
|
||||
0, /* 13 */
|
||||
TclpReaddir, /* 10 */
|
||||
TclpLocaltime_unix, /* 11 */
|
||||
TclpGmtime_unix, /* 12 */
|
||||
TclpInetNtoa, /* 13 */
|
||||
TclUnixCopyFile, /* 14 */
|
||||
TclMacOSXGetFileAttribute, /* 15 */
|
||||
TclMacOSXSetFileAttribute, /* 16 */
|
||||
@@ -698,9 +912,9 @@ const TclTomMathStubs tclTomMathStubs = {
|
||||
TclBN_mp_init_set_int, /* 61 */
|
||||
TclBN_mp_set_int, /* 62 */
|
||||
TclBN_mp_cnt_lsb, /* 63 */
|
||||
0, /* 64 */
|
||||
0, /* 65 */
|
||||
0, /* 66 */
|
||||
TclBNInitBignumFromLong, /* 64 */
|
||||
TclBNInitBignumFromWideInt, /* 65 */
|
||||
TclBNInitBignumFromWideUInt, /* 66 */
|
||||
TclBN_mp_expt_d_ex, /* 67 */
|
||||
TclBN_mp_set_long_long, /* 68 */
|
||||
TclBN_mp_get_long_long, /* 69 */
|
||||
@@ -755,11 +969,11 @@ const TclStubs tclStubs = {
|
||||
Tcl_DbDecrRefCount, /* 19 */
|
||||
Tcl_DbIncrRefCount, /* 20 */
|
||||
Tcl_DbIsShared, /* 21 */
|
||||
0, /* 22 */
|
||||
Tcl_DbNewBooleanObj, /* 22 */
|
||||
Tcl_DbNewByteArrayObj, /* 23 */
|
||||
Tcl_DbNewDoubleObj, /* 24 */
|
||||
Tcl_DbNewListObj, /* 25 */
|
||||
0, /* 26 */
|
||||
Tcl_DbNewLongObj, /* 26 */
|
||||
Tcl_DbNewObj, /* 27 */
|
||||
Tcl_DbNewStringObj, /* 28 */
|
||||
Tcl_DuplicateObj, /* 29 */
|
||||
@@ -782,21 +996,21 @@ const TclStubs tclStubs = {
|
||||
Tcl_ListObjIndex, /* 46 */
|
||||
Tcl_ListObjLength, /* 47 */
|
||||
Tcl_ListObjReplace, /* 48 */
|
||||
0, /* 49 */
|
||||
Tcl_NewBooleanObj, /* 49 */
|
||||
Tcl_NewByteArrayObj, /* 50 */
|
||||
Tcl_NewDoubleObj, /* 51 */
|
||||
0, /* 52 */
|
||||
Tcl_NewIntObj, /* 52 */
|
||||
Tcl_NewListObj, /* 53 */
|
||||
0, /* 54 */
|
||||
Tcl_NewLongObj, /* 54 */
|
||||
Tcl_NewObj, /* 55 */
|
||||
Tcl_NewStringObj, /* 56 */
|
||||
0, /* 57 */
|
||||
Tcl_SetBooleanObj, /* 57 */
|
||||
Tcl_SetByteArrayLength, /* 58 */
|
||||
Tcl_SetByteArrayObj, /* 59 */
|
||||
Tcl_SetDoubleObj, /* 60 */
|
||||
0, /* 61 */
|
||||
Tcl_SetIntObj, /* 61 */
|
||||
Tcl_SetListObj, /* 62 */
|
||||
0, /* 63 */
|
||||
Tcl_SetLongObj, /* 63 */
|
||||
Tcl_SetObjLength, /* 64 */
|
||||
Tcl_SetStringObj, /* 65 */
|
||||
Tcl_AddErrorInfo, /* 66 */
|
||||
@@ -810,7 +1024,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_AsyncMark, /* 74 */
|
||||
Tcl_AsyncReady, /* 75 */
|
||||
Tcl_BackgroundError, /* 76 */
|
||||
0, /* 77 */
|
||||
Tcl_Backslash, /* 77 */
|
||||
Tcl_BadChannelOption, /* 78 */
|
||||
Tcl_CallWhenDeleted, /* 79 */
|
||||
Tcl_CancelIdleCall, /* 80 */
|
||||
@@ -828,7 +1042,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_CreateEventSource, /* 92 */
|
||||
Tcl_CreateExitHandler, /* 93 */
|
||||
Tcl_CreateInterp, /* 94 */
|
||||
0, /* 95 */
|
||||
Tcl_CreateMathFunc, /* 95 */
|
||||
Tcl_CreateObjCommand, /* 96 */
|
||||
Tcl_CreateSlave, /* 97 */
|
||||
Tcl_CreateTimerHandler, /* 98 */
|
||||
@@ -864,7 +1078,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_ErrnoMsg, /* 128 */
|
||||
Tcl_Eval, /* 129 */
|
||||
Tcl_EvalFile, /* 130 */
|
||||
0, /* 131 */
|
||||
Tcl_EvalObj, /* 131 */
|
||||
Tcl_EventuallyFree, /* 132 */
|
||||
Tcl_Exit, /* 133 */
|
||||
Tcl_ExposeCommand, /* 134 */
|
||||
@@ -919,7 +1133,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_GetVar, /* 175 */
|
||||
Tcl_GetVar2, /* 176 */
|
||||
Tcl_GlobalEval, /* 177 */
|
||||
0, /* 178 */
|
||||
Tcl_GlobalEvalObj, /* 178 */
|
||||
Tcl_HideCommand, /* 179 */
|
||||
Tcl_Init, /* 180 */
|
||||
Tcl_InitHashTable, /* 181 */
|
||||
@@ -961,7 +1175,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_ResetResult, /* 217 */
|
||||
Tcl_ScanElement, /* 218 */
|
||||
Tcl_ScanCountedElement, /* 219 */
|
||||
0, /* 220 */
|
||||
Tcl_SeekOld, /* 220 */
|
||||
Tcl_ServiceAll, /* 221 */
|
||||
Tcl_ServiceEvent, /* 222 */
|
||||
Tcl_SetAssocData, /* 223 */
|
||||
@@ -987,7 +1201,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_SplitPath, /* 243 */
|
||||
Tcl_StaticPackage, /* 244 */
|
||||
Tcl_StringMatch, /* 245 */
|
||||
0, /* 246 */
|
||||
Tcl_TellOld, /* 246 */
|
||||
Tcl_TraceVar, /* 247 */
|
||||
Tcl_TraceVar2, /* 248 */
|
||||
Tcl_TranslateFileName, /* 249 */
|
||||
@@ -1008,18 +1222,18 @@ const TclStubs tclStubs = {
|
||||
Tcl_WrongNumArgs, /* 264 */
|
||||
Tcl_DumpActiveMemory, /* 265 */
|
||||
Tcl_ValidateAllMemory, /* 266 */
|
||||
0, /* 267 */
|
||||
0, /* 268 */
|
||||
Tcl_AppendResultVA, /* 267 */
|
||||
Tcl_AppendStringsToObjVA, /* 268 */
|
||||
Tcl_HashStats, /* 269 */
|
||||
Tcl_ParseVar, /* 270 */
|
||||
Tcl_PkgPresent, /* 271 */
|
||||
Tcl_PkgPresentEx, /* 272 */
|
||||
Tcl_PkgProvide, /* 273 */
|
||||
Tcl_PkgRequire, /* 274 */
|
||||
0, /* 275 */
|
||||
0, /* 276 */
|
||||
Tcl_SetErrorCodeVA, /* 275 */
|
||||
Tcl_VarEvalVA, /* 276 */
|
||||
Tcl_WaitPid, /* 277 */
|
||||
0, /* 278 */
|
||||
Tcl_PanicVA, /* 278 */
|
||||
Tcl_GetVersion, /* 279 */
|
||||
Tcl_InitMemory, /* 280 */
|
||||
Tcl_StackChannel, /* 281 */
|
||||
@@ -1082,8 +1296,8 @@ const TclStubs tclStubs = {
|
||||
Tcl_WriteChars, /* 338 */
|
||||
Tcl_WriteObj, /* 339 */
|
||||
Tcl_GetString, /* 340 */
|
||||
0, /* 341 */
|
||||
0, /* 342 */
|
||||
Tcl_GetDefaultEncodingDir, /* 341 */
|
||||
Tcl_SetDefaultEncodingDir, /* 342 */
|
||||
Tcl_AlertNotifier, /* 343 */
|
||||
Tcl_ServiceModeHook, /* 344 */
|
||||
Tcl_UniCharIsAlnum, /* 345 */
|
||||
@@ -1098,7 +1312,7 @@ const TclStubs tclStubs = {
|
||||
Tcl_UniCharToUtfDString, /* 354 */
|
||||
Tcl_UtfToUniCharDString, /* 355 */
|
||||
Tcl_GetRegExpFromObj, /* 356 */
|
||||
0, /* 357 */
|
||||
Tcl_EvalTokens, /* 357 */
|
||||
Tcl_FreeParse, /* 358 */
|
||||
Tcl_LogCommandInfo, /* 359 */
|
||||
Tcl_ParseBraces, /* 360 */
|
||||
@@ -1162,8 +1376,8 @@ const TclStubs tclStubs = {
|
||||
Tcl_IsChannelExisting, /* 418 */
|
||||
Tcl_UniCharNcasecmp, /* 419 */
|
||||
Tcl_UniCharCaseMatch, /* 420 */
|
||||
0, /* 421 */
|
||||
0, /* 422 */
|
||||
Tcl_FindHashEntry, /* 421 */
|
||||
Tcl_CreateHashEntry, /* 422 */
|
||||
Tcl_InitCustomHashTable, /* 423 */
|
||||
Tcl_InitObjHashTable, /* 424 */
|
||||
Tcl_CommandTraceInfo, /* 425 */
|
||||
@@ -1176,8 +1390,8 @@ const TclStubs tclStubs = {
|
||||
Tcl_AttemptSetObjLength, /* 432 */
|
||||
Tcl_GetChannelThread, /* 433 */
|
||||
Tcl_GetUnicodeFromObj, /* 434 */
|
||||
0, /* 435 */
|
||||
0, /* 436 */
|
||||
Tcl_GetMathFuncInfo, /* 435 */
|
||||
Tcl_ListMathFuncs, /* 436 */
|
||||
Tcl_SubstObj, /* 437 */
|
||||
Tcl_DetachChannel, /* 438 */
|
||||
Tcl_IsStandardChannel, /* 439 */
|
||||
|
||||
@@ -66,8 +66,8 @@ Tcl_InitStubs(
|
||||
*/
|
||||
|
||||
if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
|
||||
iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
|
||||
iPtr->legacyFreeProc = 0; /* TCL_STATIC */
|
||||
iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
|
||||
iPtr->freeProc = 0;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
+10
-6
@@ -161,7 +161,7 @@ static TestChannel *firstDetached;
|
||||
|
||||
static int AsyncHandlerProc(ClientData clientData,
|
||||
Tcl_Interp *interp, int code);
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
|
||||
#endif
|
||||
static void CleanupTestSetassocdataTests(
|
||||
@@ -722,7 +722,7 @@ Tcltest_Init(
|
||||
if (Procbodytest_Init(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
if (TclThread_Init(interp) != TCL_OK) {
|
||||
return TCL_ERROR;
|
||||
}
|
||||
@@ -902,7 +902,7 @@ TestasyncCmd(
|
||||
Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
|
||||
Tcl_MutexUnlock(&asyncTestMutex);
|
||||
return code;
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
} else if (strcmp(argv[1], "marklater") == 0) {
|
||||
if (argc != 3) {
|
||||
goto wrongNumArgs;
|
||||
@@ -999,7 +999,7 @@ AsyncHandlerProc(
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#ifdef TCL_THREADS
|
||||
#if TCL_THREADS
|
||||
static Tcl_ThreadCreateType
|
||||
AsyncThreadProc(
|
||||
ClientData clientData) /* Parameter is the id of a
|
||||
@@ -5075,6 +5075,7 @@ TestsaveresultCmd(
|
||||
int objc, /* Number of arguments. */
|
||||
Tcl_Obj *const objv[]) /* The argument objects. */
|
||||
{
|
||||
Interp* iPtr = (Interp*) interp;
|
||||
int discard, result, index;
|
||||
Tcl_SavedResult state;
|
||||
Tcl_Obj *objPtr;
|
||||
@@ -5142,9 +5143,12 @@ TestsaveresultCmd(
|
||||
}
|
||||
|
||||
switch ((enum options) index) {
|
||||
case RESULT_DYNAMIC:
|
||||
Tcl_AppendElement(interp, freeCount ? "freed" : "leak");
|
||||
case RESULT_DYNAMIC: {
|
||||
int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;
|
||||
|
||||
Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
|
||||
break;
|
||||
}
|
||||
case RESULT_OBJECT:
|
||||
Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
|
||||
? "same" : "different");
|
||||
|
||||
@@ -34,7 +34,7 @@ static const char procCommand[] = "proc";
|
||||
* procs
|
||||
*/
|
||||
|
||||
typedef struct {
|
||||
typedef struct CmdTable {
|
||||
const char *cmdName; /* command name */
|
||||
Tcl_ObjCmdProc *proc; /* command proc */
|
||||
int exportIt; /* if 1, export the command */
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user