diff options
126 files changed, 3640 insertions, 7813 deletions
@@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6.0 source distribution. + This is the Tcl 9.0a0 source distribution. http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index ae595f1..0477c88 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -30,8 +30,7 @@ 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, \fBTcl_VarEval\fR and -\fBTcl_VarEvalVA\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 diff --git a/doc/Backslash.3 b/doc/Backslash.3 deleted file mode 100644 index 8b399fc..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -1,47 +0,0 @@ -'\" -'\" 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. -'\" -.so man.macros -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.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 diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index a248cf4..d8ee2cc 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -107,31 +107,30 @@ uses. \fBInterpreter Creation And Deletion\fR . When a new interpreter is created and used in a call to \fBTcl_Eval\fR, -\fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or -\fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and -\fBTcl_Release\fR should be wrapped around all uses of the interpreter. -Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR -has been called. To ensure that the interpreter is properly deleted when -it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other -code already called \fBTcl_DeleteInterp\fR; if not, call -\fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code. +\fBTcl_VarEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of calls +to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around all +uses of the interpreter. Remember that it is unsafe to use the interpreter +once \fBTcl_Release\fR has been called. To ensure that the interpreter is +properly deleted when it is no longer needed, call \fBTcl_InterpDeleted\fR +to test if some other code already called \fBTcl_DeleteInterp\fR; if not, +call \fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own +code. .TP \fBRetrieving An Interpreter From A Data Structure\fR . When an interpreter is retrieved from a data structure (e.g. the client data of a callback) for use in one of the evaluation functions -(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_EvalObjv\fR, -etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, -\fBTcl_SetVar2Ex\fR, etc.), a pair of -calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around -all uses of the interpreter; it is unsafe to reuse the interpreter once -\fBTcl_Release\fR has been called. If an interpreter is stored inside a -callback data structure, an appropriate deletion cleanup mechanism should -be set up by the code that creates the data structure so that the -interpreter is removed from the data structure (e.g. by setting the field -to NULL) when the interpreter is deleted. Otherwise, you may be using an -interpreter that has been freed and whose memory may already have been -reused. +(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_EvalObjv\fR etc.) or variable +access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR, \fBTcl_SetVar2Ex\fR, +etc.), a pair of calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should +be wrapped around all uses of the interpreter; it is unsafe to reuse the +interpreter once \fBTcl_Release\fR has been called. If an interpreter is +stored inside a callback data structure, an appropriate deletion cleanup +mechanism should be set up by the code that creates the data structure so +that the interpreter is removed from the data structure (e.g. by setting +the field to NULL) when the interpreter is deleted. Otherwise, you may be +using an interpreter that has been freed and whose memory may already have +been reused. .PP All uses of interpreters in Tcl and Tk have already been protected. Extension writers should ensure that their code also properly protects any diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 deleted file mode 100644 index cdde20b..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -1,162 +0,0 @@ -'\" -'\" 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. -'\" -.so man.macros -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.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 diff --git a/doc/DString.3 b/doc/DString.3 index a85b1cf..9f097ab 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -9,7 +9,7 @@ .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures" .BS .SH NAME -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 +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 .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -34,8 +34,6 @@ 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) @@ -128,10 +126,6 @@ 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. diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 7bcb285..8432d61 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -8,7 +8,7 @@ .TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" .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, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- 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 \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -62,12 +62,6 @@ 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 @@ -325,7 +319,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_SetDefaultEncodingDir\fR. This procedure does not ensure that the +\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP @@ -440,15 +434,6 @@ 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 @@ -10,7 +10,7 @@ .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts +Tcl_EvalObjEx, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -19,9 +19,6 @@ int \fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR) .sp int -\fBTcl_EvalFile\fR(\fIinterp, fileName\fR) -.sp -int \fBTcl_EvalObjv\fR(\fIinterp, objc, objv, flags\fR) .sp int @@ -31,12 +28,6 @@ int \fBTcl_EvalEx\fR(\fIinterp, script, numBytes, flags\fR) .sp int -\fBTcl_GlobalEval\fR(\fIinterp, script\fR) -.sp -int -\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR) -.sp -int \fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR) .sp int @@ -93,22 +84,6 @@ 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_EvalFile\fR reads the file given by \fIfileName\fR and evaluates -its contents as a Tcl script. It returns the same information as -\fBTcl_EvalObjEx\fR. -If the file could not be read then a Tcl error is returned to describe -why the file could not be read. -The eofchar for files is -.QW \e32 -(^Z) for all platforms. If you require a -.QW ^Z -in code for string comparison, you can use -.QW \e032 -or -.QW \eu001a , -which will be safely substituted by the Tcl interpreter into -.QW ^Z . -.PP \fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a script. The \fIobjc\fR and \fIobjv\fR arguments contain the values of the words for the Tcl command, one word in each value in @@ -128,23 +103,11 @@ 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. 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. +\fBTcl_EvalObjEx\fR. .PP \fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes -additional arguments \fInumBytes\fR and \fIflags\fR. For the -efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred -over \fBTcl_Eval\fR. -.PP -\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures -that are now deprecated. They are similar to \fBTcl_EvalEx\fR and -\fBTcl_EvalObjEx\fR except that the script is evaluated in the global -namespace and its variable context consists of global variables only -(it ignores any Tcl procedures that are active). These functions are -equivalent to using the \fBTCL_EVAL_GLOBAL\fR flag (see below). +additional arguments \fInumBytes\fR and \fIflags\fR. \fBTcl_EvalEx\fR +is generally preferred over \fBTcl_Eval\fR. .PP \fBTcl_VarEval\fR takes any number of string arguments of any length, concatenates them into a single string, diff --git a/doc/GetInt.3 b/doc/GetInt.3 index f77d337..795a5b1 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -55,11 +55,15 @@ of integer digits, optionally signed and optionally preceded by white space. If the first two characters of \fIsrc\fR after the optional white space and sign are .QW 0x -then \fIsrc\fR is expected to be in hexadecimal form; otherwise, -if the first such character is -.QW 0 +then \fIsrc\fR is expected to be in hexadecimal form. +If the first two such characters are +.QW 0o then \fIsrc\fR -is expected to be in octal form; otherwise, \fIsrc\fR is +is expected to be in octal form. +If the first two such characters are +.QW 0b +then \fIsrc\fR +is expected to be in binary form; otherwise, \fIsrc\fR is expected to be in decimal form. .PP \fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point diff --git a/doc/Interp.3 b/doc/Interp.3 index d908057..d5006f9 100644 --- a/doc/Interp.3 +++ b/doc/Interp.3 @@ -33,19 +33,6 @@ 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, diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 5fd9b9c..984f56a 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -33,20 +33,16 @@ 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, \fBTcl_EvalTokens\fR -and \fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR and +\fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -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. +For \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 @@ -191,16 +187,6 @@ 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, diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index 44888f6..4629f1e 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.3 @@ -31,9 +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 -(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set -in \fIflags\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) diff --git a/doc/RecordEval.3 b/doc/RecordEval.3 index a29f974..2bd5581 100644 --- a/doc/RecordEval.3 +++ b/doc/RecordEval.3 @@ -31,8 +31,7 @@ the command at global level instead of the current stack level. .SH DESCRIPTION .PP \fBTcl_RecordAndEval\fR is invoked to record a command as an event -on the history list and then execute it using \fBTcl_Eval\fR -(or \fBTcl_GlobalEval\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set in \fIflags\fR). +on the history list and then execute it using \fBTcl_Eval\fR. It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_Eval\fR and it leaves information in the interpreter's result. If you do not want the command recorded on the history list then diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index e38ba2f..1ab5384 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -29,8 +29,8 @@ 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_GlobalEval\fR. -Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with +such as \fBTcl_EvalEx\fR. +Any call to \fBTcl_EvalEx\fR that exceeds this depth is aborted with an error. By default the recursion limit is 1000. .PP diff --git a/doc/SetResult.3 b/doc/SetResult.3 index bbeedf1..c863c5a 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -199,17 +199,11 @@ change \fIinterp->result\fR or clear error state. 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, +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, 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 diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index 0155a61..0000000 --- a/doc/case.n +++ /dev/null @@ -1,60 +0,0 @@ -'\" -'\" 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. -'\" -.so man.macros -.TH case n 7.0 Tcl "Tcl Built-In Commands" -.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 @@ -46,10 +46,7 @@ Where possible, operands are interpreted as integer values. Integer values may be specified in decimal (the normal case), in binary (if the first two characters of the operand are \fB0b\fR), in octal (if the first two characters of the operand are \fB0o\fR), or in hexadecimal -(if the first two characters of the operand are \fB0x\fR). For -compatibility with older Tcl releases, an octal integer value is also -indicated simply when the first character of the operand is \fB0\fR, -whether or not the second character is also \fBo\fR. +(if the first two characters of the operand are \fB0x\fR). If an operand does not have one of the integer formats given above, then it is treated as a floating-point number if that is possible. Floating-point numbers may be specified in any of several @@ -44,11 +44,6 @@ The remaining pattern arguments, after option processing, are treated as a single pattern obtained by joining the arguments with directory separators. .TP -\fB\-nocomplain\fR -. -Allows an empty list to be returned without error; without this -switch an error is returned if the result list would be empty. -.TP \fB\-path\fR \fIpathPrefix\fR . Search for files with the given \fIpathPrefix\fR where the rest of the name @@ -357,7 +357,7 @@ namespace separator. \fBinfo script\fR ?\fIfilename\fR? . If a Tcl script file is currently being evaluated (i.e. there is a -call to \fBTcl_EvalFile\fR active or there is an active invocation +call to \fBTcl_FSEvalFile\fR active or there is an active invocation of the \fBsource\fR command), then this command returns the name of the innermost file being processed. If \fIfilename\fR is specified, then the return value of this command will be modified for the diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 14b448e..a9b8a94 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -106,10 +106,7 @@ 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. 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. +new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR @@ -226,12 +226,10 @@ set string "#08D03F" \fBscan\fR $string "#%2x%2x%2x" r g b .CE .PP -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): +Parse a \fIHH:MM\fR time string: .PP .CS -set string "08:08" ;# *Not* octal! +set string "08:08" if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} { error "not a valid time string" } diff --git a/generic/regcustom.h b/generic/regcustom.h index 1c970ea..309203a 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -63,9 +63,6 @@ #ifdef __REG_VOID_T #undef __REG_VOID_T #endif -#ifdef __REG_CONST -#undef __REG_CONST -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -76,7 +73,6 @@ #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* Not really right, but good enough... */ #define __REG_VOID_T void -#define __REG_CONST const /* Names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec diff --git a/generic/regex.h b/generic/regex.h index d6d46ce..d09857c 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -95,9 +95,6 @@ extern "C" { #ifdef __REG_VOID_T #undef __REG_VOID_T #endif -#ifdef __REG_CONST -#undef __REG_CONST -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -108,7 +105,6 @@ extern "C" { #define __REG_WIDE_T Tcl_UniChar #define __REG_REGOFF_T long /* not really right, but good enough... */ #define __REG_VOID_T void -#define __REG_CONST const /* names and declarations */ #define __REG_WIDE_COMPILE TclReComp #define __REG_WIDE_EXEC TclReExec @@ -144,16 +140,6 @@ typedef void re_void; #endif /* - * Also for benefit of old compilers, <sys/types.h> can supply a macro which - * expands to a substitute for `const'. - */ -#ifndef __REG_CONST -#define __REG_CONST const -#endif - - - -/* * other interface types */ @@ -197,13 +183,13 @@ typedef struct { /* * compilation ^ #ifndef __REG_NOCHAR - ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int); + ^ int re_comp(regex_t *, const char *, size_t, int); ^ #endif ^ #ifndef __REG_NOFRONT - ^ int regcomp(regex_t *, __REG_CONST char *, int); + ^ int regcomp(regex_t *, const char *, int); ^ #endif ^ #ifdef __REG_WIDE_T - ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int); + ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int); ^ #endif */ #define REG_BASIC 000000 /* BREs (convenience) */ @@ -228,14 +214,14 @@ typedef struct { /* * execution ^ #ifndef __REG_NOCHAR - ^ int re_exec(regex_t *, __REG_CONST char *, size_t, + ^ int re_exec(regex_t *, const char *, size_t, ^ rm_detail_t *, size_t, regmatch_t [], int); ^ #endif ^ #ifndef __REG_NOFRONT - ^ int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int); + ^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int); ^ #endif ^ #ifdef __REG_WIDE_T - ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, + ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, ^ rm_detail_t *, size_t, regmatch_t [], int); ^ #endif */ @@ -260,7 +246,7 @@ typedef struct { * of character is used for error reports is independent of what kind is used * in matching. * - ^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t); + ^ extern size_t regerror(int, const regex_t *, char *, size_t); */ #define REG_OKAY 0 /* no errors detected */ #define REG_NOMATCH 1 /* failed to match */ @@ -292,25 +278,25 @@ typedef struct { /* automatically gathered by fwd; do not hand-edit */ /* === regproto.h === */ #ifndef __REG_NOCHAR -int re_comp(regex_t *, __REG_CONST char *, size_t, int); +int re_comp(regex_t *, const char *, size_t, int); #endif #ifndef __REG_NOFRONT -int regcomp(regex_t *, __REG_CONST char *, int); +int regcomp(regex_t *, const char *, int); #endif #ifdef __REG_WIDE_T -MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int); +MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int); #endif #ifndef __REG_NOCHAR -int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int); +int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif #ifndef __REG_NOFRONT -int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int); +int regexec(regex_t *, const char *, size_t, regmatch_t [], int); #endif #ifdef __REG_WIDE_T -MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); +MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int); #endif MODULE_SCOPE re_void regfree(regex_t *); -MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t); +MODULE_SCOPE size_t regerror(int, const regex_t *, char *, size_t); /* automatically gathered by fwd; do not hand-edit */ /* =====^!^===== end forwards =====^!^===== */ diff --git a/generic/tcl.decls b/generic/tcl.decls index 1829249..ad725f5 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -21,7 +21,7 @@ library tcl interface tcl hooks {tclPlat tclInt tclIntPlat} -scspec EXTERN +scspec TCLAPI # Declare each of the functions in the public Tcl interface. Note that # the an index should never be reused for a different function in order @@ -32,7 +32,7 @@ declare 0 { const char *version, const void *clientData) } declare 1 { - CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp, + const char *Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } @@ -154,7 +154,7 @@ declare 35 { } declare 36 { int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr) + const char *const *tablePtr, const char *msg, int flags, int *indexPtr) } declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) @@ -166,7 +166,7 @@ declare 39 { int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr) } declare 40 { - CONST86 Tcl_ObjType *Tcl_GetObjType(const char *typeName) + const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) @@ -285,9 +285,10 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -declare 77 { - char Tcl_Backslash(const char *src, int *readPtr) -} +# Removed in 9.0 +#declare 77 { +# char Tcl_Backslash(const char *src, int *readPtr) +#} declare 78 { int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList) @@ -306,7 +307,7 @@ declare 82 { int Tcl_CommandComplete(const char *cmd) } declare 83 { - char *Tcl_Concat(int argc, CONST84 char *const *argv) + char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { int Tcl_ConvertElement(const char *src, char *dst, int flags) @@ -318,7 +319,7 @@ declare 85 { declare 86 { int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, - CONST84 char *const *argv) + const char *const *argv) } declare 87 { int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, @@ -352,11 +353,11 @@ declare 93 { declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -declare 95 { - void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, - int numArgs, Tcl_ValueType *argTypes, - Tcl_MathProc *proc, ClientData clientData) -} +#declare 95 { +# 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, @@ -461,18 +462,18 @@ declare 126 { int Tcl_Eof(Tcl_Channel chan) } declare 127 { - CONST84_RETURN char *Tcl_ErrnoId(void) + const char *Tcl_ErrnoId(void) } declare 128 { - CONST84_RETURN char *Tcl_ErrnoMsg(int err) + const char *Tcl_ErrnoMsg(int err) } declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } -# This is obsolete, use Tcl_FSEvalFile -declare 130 { - int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) -} +# Removed in 9.0: +#declare 130 { +# int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) +#} declare 131 { int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) } @@ -514,9 +515,10 @@ declare 142 { declare 143 { void Tcl_Finalize(void) } -declare 144 { - void Tcl_FindExecutable(const char *argv0) -} +# Removed (from stubtable only) in 9.0: +#declare 144 { +# void Tcl_FindExecutable(const char *argv0) +#} declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) @@ -529,12 +531,12 @@ declare 147 { } declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, - int *argcPtr, CONST84 char ***argvPtr) + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, + int *argcPtr, const char ***argvPtr) } declare 149 { int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) } declare 150 { @@ -559,28 +561,28 @@ declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 { - CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan) + const char *Tcl_GetChannelName(Tcl_Channel chan) } declare 157 { int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr) } declare 158 { - CONST86 Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) + const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan) } declare 159 { int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr) } declare 160 { - CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp, + const char *Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command) } declare 161 { int Tcl_GetErrno(void) } declare 162 { - CONST84_RETURN char *Tcl_GetHostName(void) + const char *Tcl_GetHostName(void) } declare 163 { int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp) @@ -623,22 +625,23 @@ declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 { - CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp) + const char *Tcl_GetStringResult(Tcl_Interp *interp) } declare 175 { - CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, + const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags) } declare 176 { - CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, + const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 177 { - int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) -} -declare 178 { - int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} +# Removed in Tcl 9.0 +#declare 177 { +# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) +#} +#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) @@ -663,7 +666,7 @@ declare 185 { } # Obsolete, use Tcl_FSJoinPath declare 186 { - char *Tcl_JoinPath(int argc, CONST84 char *const *argv, + char *Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr) } declare 187 { @@ -686,7 +689,7 @@ declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) } declare 192 { - char *Tcl_Merge(int argc, CONST84 char *const *argv) + char *Tcl_Merge(int argc, const char *const *argv) } declare 193 { Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr) @@ -704,7 +707,7 @@ declare 196 { } declare 197 { Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, - CONST84 char **argv, int flags) + const char **argv, int flags) } # This is obsolete, use Tcl_FSOpenFileChannel declare 198 { @@ -730,7 +733,7 @@ declare 203 { int Tcl_PutEnv(const char *assignment) } declare 204 { - CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp) + const char *Tcl_PosixError(Tcl_Interp *interp) } declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) @@ -766,7 +769,7 @@ declare 214 { } declare 215 { void Tcl_RegExpRange(Tcl_RegExp regexp, int index, - CONST84 char **startPtr, CONST84 char **endPtr) + const char **startPtr, const char **endPtr) } declare 216 { void Tcl_Release(ClientData clientData) @@ -780,10 +783,10 @@ declare 218 { declare 219 { int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr) } -# Obsolete -declare 220 { - int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) -} +# Removed in Tcl 9 +#declare 220 { +# int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode) +#} declare 221 { int Tcl_ServiceAll(void) } @@ -837,29 +840,29 @@ declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 { - CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, + const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags) } declare 238 { - CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, + const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) } declare 239 { - CONST84_RETURN char *Tcl_SignalId(int sig) + const char *Tcl_SignalId(int sig) } declare 240 { - CONST84_RETURN char *Tcl_SignalMsg(int sig) + const char *Tcl_SignalMsg(int sig) } declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, - CONST84 char ***argvPtr) + const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr) + void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } declare 244 { void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, @@ -868,10 +871,10 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Obsolete -declare 246 { - int Tcl_TellOld(Tcl_Channel chan) -} +# Removed in Tcl 9 +#declare 246 { +# int Tcl_TellOld(Tcl_Channel chan) +#} declare 247 { int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) @@ -955,15 +958,15 @@ declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { - CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, - CONST84 char **termPtr) + const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr) } declare 271 { - CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 272 { - CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp, + const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } @@ -973,7 +976,7 @@ declare 273 { } # TIP #268: The internally used new Require function is in slot 573. declare 274 { - CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 275 { @@ -1087,7 +1090,7 @@ declare 301 { Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name) } declare 302 { - CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding) + const char *Tcl_GetEncodingName(Tcl_Encoding encoding) } declare 303 { void Tcl_GetEncodingNames(Tcl_Interp *interp) @@ -1163,7 +1166,7 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index) + const char *Tcl_UtfAtIndex(const char *src, int index) } declare 326 { int Tcl_UtfCharComplete(const char *src, int length) @@ -1172,16 +1175,16 @@ declare 327 { int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { - CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch) + const char *Tcl_UtfFindFirst(const char *src, int ch) } declare 329 { - CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch) + const char *Tcl_UtfFindLast(const char *src, int ch) } declare 330 { - CONST84_RETURN char *Tcl_UtfNext(const char *src) + const char *Tcl_UtfNext(const char *src) } declare 331 { - CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start) + const char *Tcl_UtfPrev(const char *src, const char *start) } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, @@ -1214,12 +1217,14 @@ declare 339 { declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -declare 341 { - CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void) -} -declare 342 { - void Tcl_SetDefaultEncodingDir(const char *path) -} +# Removed in 9.0 +#declare 341 { +# const char *Tcl_GetDefaultEncodingDir(void) +#} +# Removed in 9.0 +#declare 342 { +# void Tcl_SetDefaultEncodingDir(const char *path) +#} declare 343 { void Tcl_AlertNotifier(ClientData clientData) } @@ -1266,10 +1271,11 @@ declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -declare 357 { - Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count) -} +# Removed in 9.0: +#declare 357 { +# Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, +# int count) +#} declare 358 { void Tcl_FreeParse(Tcl_Parse *parsePtr) } @@ -1279,7 +1285,7 @@ declare 359 { } declare 360 { int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) + Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 361 { int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, @@ -1292,7 +1298,7 @@ declare 362 { declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr) + const char **termPtr) } declare 364 { int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, @@ -1408,7 +1414,7 @@ declare 397 { int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 { - CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) + const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) } declare 399 { Tcl_ChannelTypeVersion Tcl_ChannelVersion( @@ -1548,14 +1554,14 @@ declare 434 { } # TIP#15 (math function introspection) dkf -declare 435 { - int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, - int *numArgsPtr, Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, ClientData *clientDataPtr) -} -declare 436 { - Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) -} +#declare 435 { +# int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, +# int *numArgsPtr, Tcl_ValueType **argTypesPtr, +# Tcl_MathProc **procPtr, ClientData *clientDataPtr) +#} +#declare 436 { +# Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) +#} # TIP#36 (better access to 'subst') dkf declare 437 { @@ -1617,7 +1623,7 @@ declare 452 { int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr) } declare 453 { - const char *CONST86 *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, + const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) } declare 454 { @@ -1695,7 +1701,7 @@ declare 476 { Tcl_Obj *pathPtr) } declare 477 { - CONST86 Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) + const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr) } declare 478 { Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr) diff --git a/generic/tcl.h b/generic/tcl.h index 2556a9a..924f5d8 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -53,13 +53,13 @@ extern "C" { * tools/tcl.hpj.in (not patchlevel, for windows installer) */ -#define TCL_MAJOR_VERSION 8 -#define TCL_MINOR_VERSION 6 -#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE +#define TCL_MAJOR_VERSION 9 +#define TCL_MINOR_VERSION 0 +#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE #define TCL_RELEASE_SERIAL 0 -#define TCL_VERSION "8.6" -#define TCL_PATCH_LEVEL "8.6.0" +#define TCL_VERSION "9.0" +#define TCL_PATCH_LEVEL "9.0a0" /* *---------------------------------------------------------------------------- @@ -90,20 +90,6 @@ extern "C" { #endif /* __WIN32__ */ /* - * Utility macros: STRINGIFY takes an argument and wraps it in "" (double - * quotation marks), JOIN joins two arguments. - */ - -#ifndef STRINGIFY -# define STRINGIFY(x) STRINGIFY1(x) -# define STRINGIFY1(x) #x -#endif -#ifndef JOIN -# define JOIN(a,b) JOIN1(a,b) -# define JOIN1(a,b) a##b -#endif - -/* * A special definition used to allow this header file to be included from * windows resource files so that they can obtain version information. * RC_INVOKED is defined by default by the windows RC tool. @@ -149,11 +135,6 @@ extern "C" { */ #include <stdarg.h> -#ifndef TCL_NO_DEPRECATED -# define TCL_VARARGS(type, name) (type name, ...) -# define TCL_VARARGS_DEF(type, name) (type name, ...) -# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) -#endif #if defined(__GNUC__) && (__GNUC__ > 2) # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) #else @@ -232,121 +213,17 @@ extern "C" { * be reset to DLLIMPORT. */ -#undef TCL_STORAGE_CLASS #ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - -/* - * 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. - */ - -#ifndef TCL_NO_DEPRECATED -# undef _ANSI_ARGS_ -# define _ANSI_ARGS_(x) x -#endif - -/* - * Definitions that allow this header file to be used either with or without - * ANSI C features. - */ - -#ifndef INLINE -# define INLINE -#endif - -#ifdef NO_CONST -# ifndef const -# define const -# endif -#endif -#ifndef CONST -# define CONST const -#endif - -#ifdef USE_NON_CONST -# ifdef USE_COMPAT_CONST -# error define at most one of USE_NON_CONST and USE_COMPAT_CONST -# endif -# define CONST84 -# define CONST84_RETURN -#else -# ifdef USE_COMPAT_CONST -# define CONST84 -# define CONST84_RETURN const -# else -# define CONST84 const -# define CONST84_RETURN const -# endif -#endif - -#ifndef CONST86 -# define CONST86 CONST84 -#endif - -/* - * Make sure EXTERN isn't defined elsewhere. - */ - -#ifdef EXTERN -# undef EXTERN -#endif /* EXTERN */ - -#ifdef __cplusplus -# define EXTERN extern "C" TCL_STORAGE_CLASS -#else -# 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(__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 NO_VOID -# define VOID void +# define TCLAPI DLLEXPORT #else -# define VOID char +# define TCLAPI DLLIMPORT #endif /* * Miscellaneous declarations. */ -#ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif -# define _CLIENTDATA -#endif +typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where @@ -498,39 +375,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; * accessed with Tcl_GetObjResult() and Tcl_SetObjResult(). */ -typedef struct Tcl_Interp -#ifndef TCL_NO_DEPRECATED -{ - /* TIP #330: Strongly discourage extensions from using the string - * result. */ -#ifdef USE_INTERP_RESULT - char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); - /* If the last command returned a string - * result, this points to it. */ - void (*freeProc) (char *blockPtr) - TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult"); - /* Zero means the string result is statically - * allocated. TCL_DYNAMIC means it was - * allocated with ckalloc and should be freed - * with ckfree. Other values give the address - * of function to invoke to free the result. - * Tcl_Eval must free it before executing next - * command. */ -#else - char *resultDontUse; /* Don't use in extensions! */ - void (*freeProcDontUse) (char *); /* Don't use in extensions! */ -#endif -#ifdef USE_INTERP_ERRORLINE - int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine"); - /* When TCL_ERROR is returned, this gives the - * line number within the command where the - * error occurred (1 if first line). */ -#else - int errorLineDontUse; /* Don't use in extensions! */ -#endif -} -#endif /* TCL_NO_DEPRECATED */ -Tcl_Interp; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -679,8 +524,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_BREAK 3 #define TCL_CONTINUE 4 -#define TCL_RESULT_SIZE 200 - /* *---------------------------------------------------------------------------- * Flags to control what substitutions are performed by Tcl_SubstObj(): @@ -692,28 +535,14 @@ typedef struct stat *Tcl_OldStat_; #define TCL_SUBST_ALL 007 /* - * Argument descriptors for math function callbacks in expressions: - */ - -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; - -/* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ struct Tcl_Obj; +typedef struct Tcl_Obj Tcl_Value; + /* *---------------------------------------------------------------------------- * Function types defined by Tcl: @@ -726,10 +555,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); typedef void (Tcl_CloseProc) (ClientData data); typedef void (Tcl_CmdDeleteProc) (ClientData clientData); typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, - int argc, CONST84 char *argv[]); + int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, CONST84 char *argv[]); + ClientData cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); @@ -752,8 +581,6 @@ 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); @@ -766,7 +593,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, - CONST84 char *part1, CONST84 char *part2, int flags); + const char *part1, const char *part2, int flags); typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, @@ -869,13 +696,7 @@ int Tcl_IsShared(Tcl_Obj *objPtr); */ typedef struct Tcl_SavedResult { - char *result; - Tcl_FreeProc *freeProc; Tcl_Obj *objResultPtr; - char *appendResult; - int appendAvl; - int appendUsed; - char resultSpace[TCL_RESULT_SIZE+1]; } Tcl_SavedResult; /* @@ -1001,7 +822,6 @@ typedef struct Tcl_DString { #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) -#define Tcl_DStringTrunc Tcl_DStringSetLength /* * Definitions for the maximum number of digits of precision that may be @@ -1121,17 +941,6 @@ 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) - */ - -#ifndef TCL_NO_DEPRECATED -# define TCL_PARSE_PART1 0x400 -#endif - -/* * Types for linked variables: */ @@ -1414,8 +1223,8 @@ typedef struct Tcl_Time { long usec; /* Microseconds. */ } Tcl_Time; -typedef void (Tcl_SetTimerProc) (CONST86 Tcl_Time *timePtr); -typedef int (Tcl_WaitForEventProc) (CONST86 Tcl_Time *timePtr); +typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr); +typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr); /* * TIP #233 (Virtualized Time) @@ -1489,14 +1298,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, - CONST84 char *buf, int toWrite, int *errorCodePtr); + const char *buf, int toWrite, int *errorCodePtr); typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, int mode, int *errorCodePtr); typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, - Tcl_Interp *interp, CONST84 char *optionName, + Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, @@ -1687,7 +1496,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 *CONST86 * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, +typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); @@ -2377,9 +2186,6 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, *---------------------------------------------------------------------------- * The following constant is used to test for older versions of Tcl in the * stubs tables. - * - * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different - * value since the stubs tables don't match. */ #define TCL_STUB_MAGIC ((int) 0xFCA3BACF) @@ -2391,8 +2197,8 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, * main library in case an extension is statically linked into an application. */ -const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, - int exact); +const char * TclInitStubs(Tcl_Interp *interp, const char *version, + int exact, const char *tclversion, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); @@ -2400,28 +2206,28 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, * When not using stubs, make it a macro. */ -#ifndef USE_TCL_STUBS +#ifdef USE_TCL_STUBS +#define Tcl_InitStubs(interp, version, exact) \ + TclInitStubs(interp, version, exact, TCL_VERSION, TCL_STUB_MAGIC) +#else #define Tcl_InitStubs(interp, version, exact) \ Tcl_PkgInitStubsCheck(interp, version, exact) #endif /* - * TODO - tommath stubs export goes here! - */ - -/* * Public functions that are not accessible via the stubs table. * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)())) -EXTERN void Tcl_MainEx(int argc, char **argv, +TCLAPI void Tcl_FindExecutable(const char *argv0); +TCLAPI void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); -EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, +TCLAPI const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version, int exact); #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC) -EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); +TCLAPI void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #endif /* @@ -2449,15 +2255,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #ifdef TCL_MEM_DEBUG # define ckalloc(x) \ - ((VOID *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) + ((void *) Tcl_DbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define ckfree(x) \ Tcl_DbCkfree((char *)(x), __FILE__, __LINE__) # define ckrealloc(x,y) \ - ((VOID *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + ((void *) Tcl_DbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) # define attemptckalloc(x) \ - ((VOID *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) + ((void *) Tcl_AttemptDbCkalloc((unsigned)(x), __FILE__, __LINE__)) # define attemptckrealloc(x,y) \ - ((VOID *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) + ((void *) Tcl_AttemptDbCkrealloc((char *)(x), (unsigned)(y), __FILE__, __LINE__)) #else /* !TCL_MEM_DEBUG */ @@ -2468,15 +2274,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ # define ckalloc(x) \ - ((VOID *) Tcl_Alloc((unsigned)(x))) + ((void *) Tcl_Alloc((unsigned)(x))) # define ckfree(x) \ Tcl_Free((char *)(x)) # define ckrealloc(x,y) \ - ((VOID *) Tcl_Realloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_Realloc((char *)(x), (unsigned)(y))) # define attemptckalloc(x) \ - ((VOID *) Tcl_AttemptAlloc((unsigned)(x))) + ((void *) Tcl_AttemptAlloc((unsigned)(x))) # define attemptckrealloc(x,y) \ - ((VOID *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) + ((void *) Tcl_AttemptRealloc((char *)(x), (unsigned)(y))) # undef Tcl_InitMemory # define Tcl_InitMemory(x) # undef Tcl_DumpActiveMemory @@ -2602,29 +2408,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); */ #ifndef TCL_NO_DEPRECATED -/* - * These function have been renamed. The old names are deprecated, but we - * define these macros for backwards compatibilty. - */ +# 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) -# 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 -# define panic Tcl_Panic -# define panicVA Tcl_PanicVA #endif /* !TCL_NO_DEPRECATED */ -/* - *---------------------------------------------------------------------------- - * 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 /* RC_INVOKED */ /* diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index c4eeded..300e3fd 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -18,10 +18,10 @@ *- More instructions: *- done - alternate exit point (affects stack and exception range checking) *- break and continue - if exception ranges can be sorted out. - *- foreach_start4, foreach_step4 + *- foreach_start, foreach_step *- returnImm, returnStk *- expandStart, expandStkTop, invokeExpanded - *- dictFirst, dictNext, dictDone + *- dictFirst, dictNext *- dictUpdateStart, dictUpdateEnd *- jumpTable testing *- syntax (?) @@ -49,14 +49,14 @@ typedef enum BasicBlockCatchState { BBCS_UNKNOWN = 0, /* Catch context has not yet been identified */ BBCS_NONE, /* Block is outside of any catch */ BBCS_INCATCH, /* Block is within a catch context */ - BBCS_CAUGHT, /* Block is within a catch context and - * may be executed after an exception fires */ + BBCS_CAUGHT, /* Block is within a catch context and may be + * executed after an exception fires */ } BasicBlockCatchState; /* * Structure that defines a basic block - a linear sequence of bytecode - * instructions with no jumps in or out (including not changing the - * state of any exception range). + * instructions with no jumps in or out (including not changing the state of + * any exception range). */ typedef struct BasicBlock { @@ -113,8 +113,6 @@ enum BasicBlockFlags { * traversal */ BB_FALLTHRU = (1 << 1), /* Control may pass from this block to a * successor */ - BB_JUMP1 = (1 << 2), /* Basic block ends with a 1-byte-offset jump - * and may need expansion */ BB_JUMPTABLE = (1 << 3), /* Basic block ends with a jump table */ BB_BEGINCATCH = (1 << 4), /* Block ends with a 'beginCatch' instruction, * marking it as the start of a 'catch' @@ -135,7 +133,7 @@ typedef enum TalInstType { * converted to appropriate exception * ranges */ ASSEM_BOOL, /* One Boolean operand */ - ASSEM_BOOL_LVT4, /* One Boolean, one 4-byte LVT ref. */ + ASSEM_BOOL_LVT, /* One Boolean, one 4-byte LVT ref. */ ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must * be strictly positive, consumes N, produces * 1 */ @@ -151,11 +149,9 @@ typedef enum TalInstType { * compiling it in line with the assembly * code! I love Tcl!) */ ASSEM_INDEX, /* 4 byte operand, integer or end-integer */ - ASSEM_INVOKE, /* 1- or 4-byte operand count, must be - * strictly positive, consumes N, produces - * 1. */ + ASSEM_INVOKE, /* 4-byte operand count, must be strictly + * positive, consumes N, produces 1. */ ASSEM_JUMP, /* Jump instructions */ - ASSEM_JUMP4, /* Jump instructions forcing a 4-byte offset */ ASSEM_JUMPTABLE, /* Jumptable (switch -exact) */ ASSEM_LABEL, /* The assembly directive that defines a * label */ @@ -165,14 +161,10 @@ typedef enum TalInstType { * consumses N, produces 1 */ ASSEM_LSET_FLAT, /* 4-byte operand count, must be >= 3, * consumes N, produces 1 */ - ASSEM_LVT, /* One operand that references a local - * variable */ - ASSEM_LVT1, /* One 1-byte operand that references a local - * variable */ - ASSEM_LVT1_SINT1, /* One 1-byte operand that references a local + ASSEM_LVT_SINT1, /* One 4-byte operand that references a local * variable, one signed-integer 1-byte * operand */ - ASSEM_LVT4, /* One 4-byte operand that references a local + ASSEM_LVT, /* One 4-byte operand that references a local * variable */ ASSEM_OVER, /* OVER: 4-byte operand count, consumes N+1, * produces N+2 */ @@ -183,7 +175,7 @@ typedef enum TalInstType { * produces N */ ASSEM_SINT1, /* One 1-byte signed-integer operand * (INCR_STK_IMM) */ - ASSEM_SINT4_LVT4, /* Signed 4-byte integer operand followed by + ASSEM_SINT4_LVT, /* Signed 4-byte integer operand followed by * LVT entry. Fixed arity */ } TalInstType; @@ -244,8 +236,6 @@ static void BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx, int opnd, int count); static void BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx, int opnd, int count); -static void BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx, - int param, int count); static void BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx, int count); static int BuildExceptionRanges(AssemblyEnv* assemEnvPtr); @@ -324,66 +314,39 @@ static const Tcl_ObjType assembleCodeType = { }; /* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ - -/* * Source instructions recognized in the Tcl Assembly Language (TAL) */ static const TalInstDesc TalInstructionTable[] = { /* PUSH must be first, see the code near the end of TclAssembleCode */ - {"push", ASSEM_PUSH, (INST_PUSH1<<8 - | INST_PUSH4), 0, 1}, + {"push", ASSEM_PUSH, INST_PUSH, 0, 1}, {"add", ASSEM_1BYTE, INST_ADD, 2, 1}, - {"append", ASSEM_LVT, (INST_APPEND_SCALAR1<<8 - | INST_APPEND_SCALAR4),1, 1}, - {"appendArray", ASSEM_LVT, (INST_APPEND_ARRAY1<<8 - | INST_APPEND_ARRAY4), 2, 1}, + {"append", ASSEM_LVT, INST_APPEND_SCALAR, 1, 1}, + {"appendArray", ASSEM_LVT, INST_APPEND_ARRAY, 2, 1}, {"appendArrayStk", ASSEM_1BYTE, INST_APPEND_ARRAY_STK, 3, 1}, {"appendStk", ASSEM_1BYTE, INST_APPEND_STK, 2, 1}, - {"arrayExistsImm", ASSEM_LVT4, INST_ARRAY_EXISTS_IMM, 0, 1}, + {"arrayExistsImm", ASSEM_LVT, INST_ARRAY_EXISTS_IMM, 0, 1}, {"arrayExistsStk", ASSEM_1BYTE, INST_ARRAY_EXISTS_STK, 1, 1}, - {"arrayMakeImm", ASSEM_LVT4, INST_ARRAY_MAKE_IMM, 0, 0}, + {"arrayMakeImm", ASSEM_LVT, INST_ARRAY_MAKE_IMM, 0, 0}, {"arrayMakeStk", ASSEM_1BYTE, INST_ARRAY_MAKE_STK, 1, 0}, {"beginCatch", ASSEM_BEGIN_CATCH, - INST_BEGIN_CATCH4, 0, 0}, + INST_BEGIN_CATCH, 0, 0}, {"bitand", ASSEM_1BYTE, INST_BITAND, 2, 1}, {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, - {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1}, + {"concat", ASSEM_CONCAT1, INST_CONCAT, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1}, - {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, + {"dictAppend", ASSEM_LVT, INST_DICT_APPEND, 2, 1}, {"dictExists", ASSEM_DICT_GET, INST_DICT_EXISTS, INT_MIN,1}, {"dictExpand", ASSEM_1BYTE, INST_DICT_EXPAND, 3, 1}, {"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1}, - {"dictIncrImm", ASSEM_SINT4_LVT4, - INST_DICT_INCR_IMM, 1, 1}, - {"dictLappend", ASSEM_LVT4, INST_DICT_LAPPEND, 2, 1}, + {"dictIncrImm", ASSEM_SINT4_LVT,INST_DICT_INCR_IMM, 1, 1}, + {"dictLappend", ASSEM_LVT, INST_DICT_LAPPEND, 2, 1}, {"dictRecombineStk",ASSEM_1BYTE, INST_DICT_RECOMBINE_STK,3, 0}, - {"dictRecombineImm",ASSEM_LVT4, INST_DICT_RECOMBINE_IMM,2, 0}, + {"dictRecombineImm",ASSEM_LVT, INST_DICT_RECOMBINE_IMM,2, 0}, {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1}, {"dictUnset", ASSEM_DICT_UNSET, INST_DICT_UNSET, INT_MIN,1}, @@ -393,8 +356,9 @@ static const TalInstDesc TalInstructionTable[] = { {"eq", ASSEM_1BYTE, INST_EQ, 2, 1}, {"eval", ASSEM_EVAL, INST_EVAL_STK, 1, 1}, {"evalStk", ASSEM_1BYTE, INST_EVAL_STK, 1, 1}, - {"exist", ASSEM_LVT4, INST_EXIST_SCALAR, 0, 1}, - {"existArray", ASSEM_LVT4, INST_EXIST_ARRAY, 1, 1}, + {"exch", ASSEM_1BYTE, INST_EXCH, 2, 2}, + {"exist", ASSEM_LVT, INST_EXIST_SCALAR, 0, 1}, + {"existArray", ASSEM_LVT, INST_EXIST_ARRAY, 1, 1}, {"existArrayStk", ASSEM_1BYTE, INST_EXIST_ARRAY_STK, 2, 1}, {"existStk", ASSEM_1BYTE, INST_EXIST_STK, 1, 1}, {"expon", ASSEM_1BYTE, INST_EXPON, 2, 1}, @@ -402,35 +366,25 @@ static const TalInstDesc TalInstructionTable[] = { {"exprStk", ASSEM_1BYTE, INST_EXPR_STK, 1, 1}, {"ge", ASSEM_1BYTE, INST_GE, 2, 1}, {"gt", ASSEM_1BYTE, INST_GT, 2, 1}, - {"incr", ASSEM_LVT1, INST_INCR_SCALAR1, 1, 1}, - {"incrArray", ASSEM_LVT1, INST_INCR_ARRAY1, 2, 1}, - {"incrArrayImm", ASSEM_LVT1_SINT1, - INST_INCR_ARRAY1_IMM, 1, 1}, + {"incr", ASSEM_LVT, INST_INCR_SCALAR, 1, 1}, + {"incrArray", ASSEM_LVT, INST_INCR_ARRAY, 2, 1}, + {"incrArrayImm", ASSEM_LVT_SINT1,INST_INCR_ARRAY_IMM, 1, 1}, {"incrArrayStk", ASSEM_1BYTE, INST_INCR_ARRAY_STK, 3, 1}, {"incrArrayStkImm", ASSEM_SINT1, INST_INCR_ARRAY_STK_IMM,2, 1}, - {"incrImm", ASSEM_LVT1_SINT1, - INST_INCR_SCALAR1_IMM, 0, 1}, - {"incrStk", ASSEM_1BYTE, INST_INCR_SCALAR_STK, 2, 1}, - {"incrStkImm", ASSEM_SINT1, INST_INCR_SCALAR_STK_IMM, - 1, 1}, + {"incrImm", ASSEM_LVT_SINT1,INST_INCR_SCALAR_IMM, 0, 1}, + {"incrStk", ASSEM_1BYTE, INST_INCR_STK, 2, 1}, + {"incrStkImm", ASSEM_SINT1, INST_INCR_STK_IMM, 1, 1}, {"infoLevelArgs", ASSEM_1BYTE, INST_INFO_LEVEL_ARGS, 1, 1}, {"infoLevelNumber", ASSEM_1BYTE, INST_INFO_LEVEL_NUM, 0, 1}, - {"invokeStk", ASSEM_INVOKE, (INST_INVOKE_STK1 << 8 - | INST_INVOKE_STK4), INT_MIN,1}, - {"jump", ASSEM_JUMP, INST_JUMP1, 0, 0}, - {"jump4", ASSEM_JUMP4, INST_JUMP4, 0, 0}, - {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE1, 1, 0}, - {"jumpFalse4", ASSEM_JUMP4, INST_JUMP_FALSE4, 1, 0}, + {"invokeStk", ASSEM_INVOKE, INST_INVOKE_STK, INT_MIN,1}, + {"jump", ASSEM_JUMP, INST_JUMP, 0, 0}, + {"jumpFalse", ASSEM_JUMP, INST_JUMP_FALSE, 1, 0}, {"jumpTable", ASSEM_JUMPTABLE,INST_JUMP_TABLE, 1, 0}, - {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE1, 1, 0}, - {"jumpTrue4", ASSEM_JUMP4, INST_JUMP_TRUE4, 1, 0}, + {"jumpTrue", ASSEM_JUMP, INST_JUMP_TRUE, 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}, - {"lappendArray", ASSEM_LVT, (INST_LAPPEND_ARRAY1<<8 - | INST_LAPPEND_ARRAY4),2, 1}, + {"lappend", ASSEM_LVT, INST_LAPPEND_SCALAR, 1, 1}, + {"lappendArray", ASSEM_LVT, INST_LAPPEND_ARRAY, 2, 1}, {"lappendArrayStk", ASSEM_1BYTE, INST_LAPPEND_ARRAY_STK, 3, 1}, {"lappendStk", ASSEM_1BYTE, INST_LAPPEND_STK, 2, 1}, {"le", ASSEM_1BYTE, INST_LE, 2, 1}, @@ -442,10 +396,8 @@ static const TalInstDesc TalInstructionTable[] = { {"listIndexImm", ASSEM_INDEX, INST_LIST_INDEX_IMM, 1, 1}, {"listLength", ASSEM_1BYTE, INST_LIST_LENGTH, 1, 1}, {"listNotIn", ASSEM_1BYTE, INST_LIST_NOT_IN, 2, 1}, - {"load", ASSEM_LVT, (INST_LOAD_SCALAR1 << 8 - | INST_LOAD_SCALAR4), 0, 1}, - {"loadArray", ASSEM_LVT, (INST_LOAD_ARRAY1<<8 - | INST_LOAD_ARRAY4), 1, 1}, + {"load", ASSEM_LVT, INST_LOAD_SCALAR, 0, 1}, + {"loadArray", ASSEM_LVT, INST_LOAD_ARRAY, 1, 1}, {"loadArrayStk", ASSEM_1BYTE, INST_LOAD_ARRAY_STK, 2, 1}, {"loadStk", ASSEM_1BYTE, INST_LOAD_SCALAR_STK, 1, 1}, {"lor", ASSEM_1BYTE, INST_LOR, 2, 1}, @@ -458,7 +410,7 @@ static const TalInstDesc TalInstructionTable[] = { {"neq", ASSEM_1BYTE, INST_NEQ, 2, 1}, {"nop", ASSEM_1BYTE, INST_NOP, 0, 0}, {"not", ASSEM_1BYTE, INST_LNOT, 1, 1}, - {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}, + {"nsupvar", ASSEM_LVT, INST_NSUPVAR, 2, 1}, {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, @@ -469,10 +421,8 @@ static const TalInstDesc TalInstructionTable[] = { {"resolveCmd", ASSEM_1BYTE, INST_RESOLVE_COMMAND, 1, 1}, {"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN,-1-0}, {"rshift", ASSEM_1BYTE, INST_RSHIFT, 2, 1}, - {"store", ASSEM_LVT, (INST_STORE_SCALAR1<<8 - | INST_STORE_SCALAR4), 1, 1}, - {"storeArray", ASSEM_LVT, (INST_STORE_ARRAY1<<8 - | INST_STORE_ARRAY4), 2, 1}, + {"store", ASSEM_LVT, INST_STORE_SCALAR, 1, 1}, + {"storeArray", ASSEM_LVT, INST_STORE_ARRAY, 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, {"storeStk", ASSEM_1BYTE, INST_STORE_SCALAR_STK, 2, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, @@ -492,13 +442,14 @@ static const TalInstDesc TalInstructionTable[] = { {"tclooSelf", ASSEM_1BYTE, INST_TCLOO_SELF, 0, 1}, {"tryCvtToNumeric", ASSEM_1BYTE, INST_TRY_CVT_TO_NUMERIC,1, 1}, {"uminus", ASSEM_1BYTE, INST_UMINUS, 1, 1}, - {"unset", ASSEM_BOOL_LVT4,INST_UNSET_SCALAR, 0, 0}, - {"unsetArray", ASSEM_BOOL_LVT4,INST_UNSET_ARRAY, 1, 0}, + {"under", ASSEM_1BYTE, INST_UNDER, 2, 3}, + {"unset", ASSEM_BOOL_LVT, INST_UNSET_SCALAR, 0, 0}, + {"unsetArray", ASSEM_BOOL_LVT, INST_UNSET_ARRAY, 1, 0}, {"unsetArrayStk", ASSEM_BOOL, INST_UNSET_ARRAY_STK, 2, 0}, {"unsetStk", ASSEM_BOOL, INST_UNSET_STK, 1, 0}, {"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1}, - {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}, - {"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0}, + {"upvar", ASSEM_LVT, INST_UPVAR, 2, 1}, + {"variable", ASSEM_LVT, INST_VARIABLE, 1, 0}, {"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0}, {"yield", ASSEM_1BYTE, INST_YIELD, 1, 1}, {NULL, 0, 0, 0, 0} @@ -509,23 +460,16 @@ static const TalInstDesc TalInstructionTable[] = { * circumstances. These instructions are the ones that are permissible after * an exception is caught but before the corresponding exception range is * popped from the stack. + * * The instructions must be in ascending order by numeric operation code. */ static const unsigned char NonThrowingByteCodes[] = { - INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ - INST_JUMP1, INST_JUMP4, /* 34-35 */ - INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ - INST_OVER, /* 95 */ - INST_PUSH_RETURN_OPTIONS, /* 108 */ - INST_REVERSE, /* 126 */ - INST_NOP, /* 132 */ - INST_STR_MAP, /* 143 */ - INST_STR_FIND, /* 144 */ - INST_COROUTINE_NAME, /* 149 */ - INST_NS_CURRENT, /* 151 */ - INST_INFO_LEVEL_NUM, /* 152 */ - INST_RESOLVE_COMMAND /* 154 */ + INST_PUSH, INST_POP, INST_DUP, INST_JUMP, + INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, + INST_PUSH_RETURN_OPTIONS, INST_OVER, INST_REVERSE, INST_NOP, + INST_STR_MAP, INST_STR_FIND, INST_COROUTINE_NAME, INST_NS_CURRENT, + INST_INFO_LEVEL_NUM, INST_RESOLVE_COMMAND, INST_EXCH, INST_UNDER }; /* @@ -702,45 +646,6 @@ BBEmitInstInt4( /* *----------------------------------------------------------------------------- * - * BBEmitInst1or4 -- - * - * Emits a 1- or 4-byte operation according to the magnitude of the - * operand - * - *----------------------------------------------------------------------------- - */ - -static void -BBEmitInst1or4( - AssemblyEnv* assemEnvPtr, /* Assembly environment */ - int tblIdx, /* Index in TalInstructionTable of op */ - int param, /* Variable-length parameter */ - int count) /* Arity if variadic */ -{ - CompileEnv* envPtr = assemEnvPtr->envPtr; - /* Compilation environment */ - BasicBlock* bbPtr = assemEnvPtr->curr_bb; - /* Current basic block */ - int op = TalInstructionTable[tblIdx].tclInstCode; - - if (param <= 0xff) { - op >>= 8; - } else { - op &= 0xff; - } - TclEmitInt1(op, envPtr); - if (param <= 0xff) { - TclEmitInt1(param, envPtr); - } else { - TclEmitInt4(param, envPtr); - } - envPtr->atCmdStart = ((op) == INST_START_CMD); - BBUpdateStackReqs(bbPtr, tblIdx, count); -} - -/* - *----------------------------------------------------------------------------- - * * Tcl_AssembleObjCmd, TclNRAssembleObjCmd -- * * Direct evaluation path for tcl::unsupported::assemble @@ -902,7 +807,7 @@ CompileAssembleObj( for (i = 0; i < compEnv.auxDataArrayNext; i++) { auxDataPtr = compEnv.auxDataArrayPtr + i; if (auxDataPtr->type->freeProc != NULL) { - (auxDataPtr->type->freeProc)(auxDataPtr->clientData); + auxDataPtr->type->freeProc(auxDataPtr->clientData); } } @@ -1329,7 +1234,7 @@ AssembleOneLine( } operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len); litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len); - BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0); + BBEmitInstInt4(assemEnvPtr, tblIdx, litIndex, 0); break; case ASSEM_1BYTE: @@ -1373,7 +1278,7 @@ AssembleOneLine( BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; - case ASSEM_BOOL_LVT4: + case ASSEM_BOOL_LVT: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; @@ -1483,7 +1388,7 @@ AssembleOneLine( * Assumes that PUSH is the first slot! */ - BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); + BBEmitInstInt4(assemEnvPtr, 0, litIndex, 0); BBEmitOpcode(assemEnvPtr, tblIdx, 0); } break; @@ -1498,11 +1403,10 @@ AssembleOneLine( goto cleanup; } - BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd); + BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_JUMP: - case ASSEM_JUMP4: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "label"); goto cleanup; @@ -1511,13 +1415,8 @@ AssembleOneLine( goto cleanup; } assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart; - if (instType == ASSEM_JUMP) { - flags = BB_JUMP1; - BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0); - } else { - flags = 0; - BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0); - } + flags = 0; + BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0); /* * Start a new basic block at the instruction following the jump. @@ -1630,46 +1529,22 @@ AssembleOneLine( BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; - case ASSEM_LVT: - if (parsePtr->numWords != 2) { - Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); - goto cleanup; - } - localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0) { - goto cleanup; - } - BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); - break; - - case ASSEM_LVT1: - if (parsePtr->numWords != 2) { - Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); - goto cleanup; - } - localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0 || CheckOneByte(interp, localVar)) { - goto cleanup; - } - BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); - break; - - case ASSEM_LVT1_SINT1: + case ASSEM_LVT_SINT1: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar < 0 || CheckOneByte(interp, localVar) + if (localVar < 0 || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd)) { goto cleanup; } - BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); + BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); TclEmitInt1(opnd, envPtr); break; - case ASSEM_LVT4: + case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; @@ -1732,7 +1607,7 @@ AssembleOneLine( BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); break; - case ASSEM_SINT4_LVT4: + case ASSEM_SINT4_LVT: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; @@ -2792,15 +2667,9 @@ CalculateJumpRelocations( int* mustMove) /* OUTPUT: Number of bytes that have been * added to the code */ { - CompileEnv* envPtr = assemEnvPtr->envPtr; - /* Compilation environment */ BasicBlock* bbPtr; /* Pointer to a basic block being checked */ Tcl_HashEntry* entry; /* Exit label's entry in the symbol table */ - BasicBlock* jumpTarget; /* Basic block where the jump goes */ int motion; /* Amount by which the code has expanded */ - int offset; /* Offset in the bytecode from a jump - * instruction to its target */ - unsigned opcode; /* Opcode in the bytecode being adjusted */ /* * Iterate through basic blocks as long as a change results in code @@ -2834,26 +2703,6 @@ CalculateJumpRelocations( bbPtr->jumpTarget); return TCL_ERROR; } - - /* - * If the instruction is a JUMP1, turn it into a JUMP4 if its - * target is out of range. - */ - - jumpTarget = Tcl_GetHashValue(entry); - if (bbPtr->flags & BB_JUMP1) { - offset = jumpTarget->startOffset - - (bbPtr->jumpOffset + motion); - if (offset < -0x80 || offset > 0x7f) { - opcode = TclGetUInt1AtPtr(envPtr->codeStart - + bbPtr->jumpOffset); - ++opcode; - TclStoreInt1AtPtr(opcode, - envPtr->codeStart + bbPtr->jumpOffset); - motion += 3; - bbPtr->flags &= ~BB_JUMP1; - } - } } /* @@ -3039,13 +2888,8 @@ FillInJumpOffsets( jumpTarget = Tcl_GetHashValue(entry); fromOffset = bbPtr->jumpOffset; targetOffset = jumpTarget->startOffset; - if (bbPtr->flags & BB_JUMP1) { - TclStoreInt1AtPtr(targetOffset - fromOffset, - envPtr->codeStart + fromOffset + 1); - } else { - TclStoreInt4AtPtr(targetOffset - fromOffset, - envPtr->codeStart + fromOffset + 1); - } + TclStoreInt4AtPtr(targetOffset - fromOffset, + envPtr->codeStart + fromOffset + 1); } if (bbPtr->flags & BB_JUMPTABLE) { ResolveJumpTableTargets(assemEnvPtr, bbPtr); @@ -3225,7 +3069,7 @@ CheckNonThrowingBlock( * Determine whether an instruction is nonthrowing. */ - opcode = (envPtr->codeStart)[offset]; + opcode = envPtr->codeStart[offset]; if (BytecodeMightThrow(opcode)) { /* * Report an error for a throw in the wrong context. @@ -3574,7 +3418,7 @@ StackCheckExit( * Assumes that 'push' is at slot 0 in TalInstructionTable. */ - BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0); + BBEmitInstInt4(assemEnvPtr, 0, litIndex, 0); ++depth; } @@ -4195,13 +4039,13 @@ RestoreEmbeddedExceptionRanges( /* * Walk through the bytecode of the basic block, and relocate - * INST_BEGIN_CATCH4 instructions to the new locations + * INST_BEGIN_CATCH instructions to the new locations */ i = bbPtr->startOffset; while (i < bbPtr->successor1->startOffset) { opcode = envPtr->codeStart[i]; - if (opcode == INST_BEGIN_CATCH4) { + if (opcode == INST_BEGIN_CATCH) { catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1); if (catchIndex >= bbPtr->foreignExceptionBase && catchIndex < (bbPtr->foreignExceptionBase + diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c8cfb49..ab712e8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -41,18 +41,6 @@ #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 * cancellation requests, including the original interp, asynchronous handler @@ -135,8 +123,6 @@ static Tcl_NRPostProc NRCoroutineCallerCallback; static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); -static Tcl_ObjCmdProc OldMathFuncProc; -static void OldMathFuncDeleteProc(ClientData clientData); static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); @@ -201,9 +187,6 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, 1}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, 1}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, 1}, -#ifndef EXCLUDE_OBSOLETE_COMMANDS - {"case", Tcl_CaseObjCmd, NULL, NULL, 1}, -#endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, 1}, {"concat", Tcl_ConcatObjCmd, NULL, NULL, 1}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, 1}, @@ -498,9 +481,12 @@ Tcl_CreateInterp(void) iPtr = ckalloc(sizeof(Interp)); interp = (Tcl_Interp *) iPtr; - iPtr->result = iPtr->resultSpace; - iPtr->freeProc = NULL; + iPtr->legacyResult = NULL; + /* Special invalid value: Any attempt to free the legacy result + * will cause a crash. */ + iPtr->legacyFreeProc = (void (*) (void))-1; iPtr->errorLine = 0; + iPtr->stubTable = &tclStubs; iPtr->objResultPtr = Tcl_NewObj(); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); @@ -555,10 +541,6 @@ Tcl_CreateInterp(void) iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */ iPtr->lookupNsPtr = NULL; - iPtr->appendResult = NULL; - iPtr->appendAvl = 0; - iPtr->appendUsed = 0; - Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS); iPtr->packageUnknown = NULL; @@ -586,7 +568,6 @@ Tcl_CreateInterp(void) iPtr->emptyObjPtr = Tcl_NewObj(); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); - iPtr->resultSpace[0] = 0; iPtr->threadId = Tcl_GetCurrentThread(); /* TIP #378 */ @@ -700,12 +681,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ @@ -1488,7 +1463,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1510,10 +1484,6 @@ DeleteInterpProc( if (iPtr->returnOpts) { Tcl_DecrRefCount(iPtr->returnOpts); } - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - iPtr->appendResult = NULL; - } TclFreePackageInfo(iPtr); while (iPtr->tracePtr != NULL) { Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr); @@ -2387,7 +2357,7 @@ TclInvokeStringCommand( * in the Command structure. * * Results: - * A standard Tcl string result value. + * A standard Tcl result value. * * Side effects: * Besides those side effects of the called Tcl_CmdProc, @@ -2428,13 +2398,6 @@ TclInvokeObjectCommand( } /* - * 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. */ @@ -3426,360 +3389,6 @@ 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. - * - *---------------------------------------------------------------------- - */ - -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, /* Ponter 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, Tcl_GetString(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 (Tcl_GetWideIntFromObj(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); - Tcl_GetWideIntFromObj(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) { - TclNewLongObj(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; -} - -/* - *---------------------------------------------------------------------- - * * TclInterpReady -- * * Check if an interpreter is ready to eval commands or scripts, i.e., if @@ -3790,7 +3399,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -3802,8 +3411,8 @@ TclInterpReady( register Interp *iPtr = (Interp *) interp; /* - * Reset both the interpreter's string and object results and clear out - * any previous error information. + * Reset the interpreter's result and clear out any previous error + * information. */ Tcl_ResetResult(interp); @@ -4310,24 +3919,9 @@ TclNRRunCallbacks( /* All callbacks down to rootPtr not inclusive * are to be run. */ { - Interp *iPtr = (Interp *) interp; 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 (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } - while (TOP_CB(interp) != rootPtr) { callbackPtr = TOP_CB(interp); procPtr = callbackPtr->procPtr; @@ -4802,54 +4396,6 @@ Tcl_EvalTokensStandard( /* *---------------------------------------------------------------------- * - * 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; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalEx, TclEvalEx -- * * This function evaluates a Tcl script without using the compiler or @@ -5797,16 +5343,7 @@ Tcl_Eval( * previous call to Tcl_CreateInterp). */ const char *script) /* Pointer to TCL command to execute. */ { - 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; + return Tcl_EvalEx(interp, script, -1, 0); } /* @@ -5826,6 +5363,7 @@ Tcl_Eval( *---------------------------------------------------------------------- */ +#undef Tcl_EvalObj int Tcl_EvalObj( Tcl_Interp *interp, @@ -5833,6 +5371,7 @@ Tcl_EvalObj( { return Tcl_EvalObjEx(interp, objPtr, 0); } +#undef Tcl_GlobalEvalObj int Tcl_GlobalEvalObj( Tcl_Interp *interp, @@ -6303,9 +5842,6 @@ Tcl_ExprLong( Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); - if (result != TCL_OK) { - (void) Tcl_GetStringResult(interp); - } } return result; } @@ -6332,9 +5868,6 @@ 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; } @@ -6360,14 +5893,6 @@ 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; } } @@ -6693,12 +6218,6 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } @@ -6802,19 +6321,7 @@ Tcl_AddObjErrorInfo( iPtr->flags |= ERR_LEGACY_COPY; if (iPtr->errorInfo == NULL) { - if (iPtr->result[0] != 0) { - /* - * The interp's string result is set, apparently by some extension - * making a deprecated direct write to it. That extension may - * 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 { - iPtr->errorInfo = iPtr->objResultPtr; - } + iPtr->errorInfo = iPtr->objResultPtr; Tcl_IncrRefCount(iPtr->errorInfo); if (!iPtr->errorCode) { Tcl_SetErrorCode(interp, "NONE", NULL); @@ -6892,7 +6399,7 @@ Tcl_VarEvalVA( * * Results: * A standard Tcl return result. An error message or other result may be - * left in interp->result. + * left in the interp. * * Side effects: * Depends on what was done by the command. @@ -6918,42 +6425,6 @@ Tcl_VarEval( /* *---------------------------------------------------------------------- * - * Tcl_GlobalEval -- - * - * Evaluate a command at global level in an interpreter. - * - * Results: - * A standard Tcl result is returned, and the interp's result is modified - * accordingly. - * - * Side effects: - * The command string is executed in interp, and the execution is carried - * out in the variable context of global level (no functions active), - * just as if an "uplevel #0" command were being executed. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_GlobalEval( - Tcl_Interp *interp, /* Interpreter in which to evaluate - * command. */ - const char *command) /* Command to evaluate. */ -{ - register Interp *iPtr = (Interp *) interp; - int result; - CallFrame *savedVarFramePtr; - - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = iPtr->rootFramePtr; - result = Tcl_Eval(interp, command); - iPtr->varFramePtr = savedVarFramePtr; - return result; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetRecursionLimit -- * * Set the maximum number of recursive calls that may be active for an diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 820eec5..8468356 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -133,143 +133,6 @@ Tcl_BreakObjCmd( /* *---------------------------------------------------------------------- * - * 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. - * - *---------------------------------------------------------------------- - */ - - /* 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; - unsigned char *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 = (unsigned char *) pat; *p != '\0'; p++) { - if (isspace(*p) || (*p == '\\')) { /* INTL: ISO space, UCHAR */ - 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; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 389c1ee..4549753 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -36,11 +36,6 @@ static void CompileReturnInternal(CompileEnv *envPtr, Tcl_Obj *returnOpts); static int IndexTailVarIfKnown(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr); -static int PushVarName(Tcl_Interp *interp, - Tcl_Token *varTokenPtr, CompileEnv *envPtr, - int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); static int CompileEachloopCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, int collect); @@ -48,67 +43,6 @@ static int CompileDictEachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr, int collect); - -/* - * Macro that encapsulates an efficiency trick that avoids a function call for - * the simplest of compiles. The ANSI C "prototype" for this macro is: - * - * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, - * Tcl_Interp *interp, int word); - */ - -#define CompileWord(envPtr, tokenPtr, interp, word) \ - if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ - TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ - (tokenPtr)[1].size), (envPtr)); \ - } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ - TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)); \ - } - -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - -/* - * Often want to issue one of two versions of an instruction based on whether - * the argument will fit in a single byte or not. This makes it much clearer. - */ - -#define Emit14Inst(nm,idx,envPtr) \ - if (idx <= 255) { \ - TclEmitInstInt1(nm##1,idx,envPtr); \ - } else { \ - TclEmitInstInt4(nm##4,idx,envPtr); \ - } - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ -#define TCL_NO_ELEMENT 2 /* Do not push the array element. */ - /* * The structures below define the AuxData types defined in this file. */ @@ -154,7 +88,7 @@ TclCompileAppendCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *varTokenPtr, *valueTokenPtr; + Tcl_Token *varTokenPtr; int simpleVarName, isScalar, localIndex, numWords; DefineLineInformation; /* TIP #280 */ @@ -185,8 +119,8 @@ TclCompileAppendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * We are doing an assignment, otherwise TclCompileSetCmd was called, so @@ -195,8 +129,7 @@ TclCompileAppendCmd( */ if (numWords > 2) { - valueTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, valueTokenPtr, interp, 2); + PUSH_SUBST_WORD(TokenAfter(varTokenPtr), 2); } /* @@ -206,19 +139,19 @@ TclCompileAppendCmd( if (simpleVarName) { if (isScalar) { if (localIndex < 0) { - TclEmitOpcode(INST_APPEND_STK, envPtr); + OP( APPEND_STK); } else { - Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr); + OP4( APPEND_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr); + OP( APPEND_ARRAY_STK); } else { - Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr); + OP4( APPEND_ARRAY, localIndex); } } } else { - TclEmitOpcode(INST_APPEND_STK, envPtr); + OP( APPEND_STK); } return TCL_OK; @@ -267,9 +200,9 @@ TclCompileArrayExistsCmd( } if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); } else { - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); + OP( ARRAY_EXISTS_STK); } return TCL_OK; } @@ -287,7 +220,7 @@ TclCompileArraySetCmd( Tcl_Token *tokenPtr; int simpleVarName, isScalar, localIndex; int dataVar, iterVar, keyVar, valVar, infoIndex; - int back, fwd, offsetBack, offsetFwd, savedStackDepth; + int offsetBack, offsetFwd, savedStackDepth; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { @@ -309,20 +242,20 @@ TclCompileArraySetCmd( if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD && tokenPtr[1].size == 0) { if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); - TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); + OP4( JUMP_TRUE, 10); + OP4( ARRAY_MAKE_IMM, localIndex); } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 5, envPtr); + OP( DUP); + OP( ARRAY_EXISTS_STK); + OP4( JUMP_TRUE, 11); savedStackDepth = envPtr->currStackDepth; - TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); - TclEmitInstInt1(INST_JUMP1, 3, envPtr); + OP( ARRAY_MAKE_STK); + OP4( JUMP, 6); envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } @@ -343,9 +276,9 @@ TclCompileArraySetCmd( cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); - TclEmitInstInt4(INST_REVERSE, 2, envPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitInstInt1(INST_INVOKE_STK1, 3, envPtr); + OP( EXCH); + PUSH_SUBST_WORD(tokenPtr, 2); + OP4( INVOKE_STK, 3); return TCL_OK; } @@ -353,10 +286,10 @@ TclCompileArraySetCmd( * Prepare for the internal foreach. */ - dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + dataVar = NewUnnamedLocal(envPtr); + iterVar = NewUnnamedLocal(envPtr); + keyVar = NewUnnamedLocal(envPtr); + valVar = NewUnnamedLocal(envPtr); infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; @@ -372,72 +305,60 @@ TclCompileArraySetCmd( * Start issuing instructions to write to the array. */ - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - PushLiteral(envPtr, "1", 1); - TclEmitOpcode( INST_BITAND, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr); + PUSH_SUBST_WORD( tokenPtr, 2); + OP( DUP); + OP( LIST_LENGTH); + PUSH( "1"); + OP( BITAND); + JUMP(offsetFwd, JUMP_FALSE); savedStackDepth = envPtr->currStackDepth; - PushLiteral(envPtr, "list must have an even number of elements", - strlen("list must have an even number of elements")); - PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}", - strlen("-errorCode {TCL ARGUMENT FORMAT}")); - TclEmitInstInt4( INST_RETURN_IMM, 1, envPtr); - TclEmitInt4( 0, envPtr); + PUSH( "list must have an even number of elements"); + PUSH( "-errorCode {TCL ARGUMENT FORMAT}"); + OP44( RETURN_IMM, 1, 0); envPtr->currStackDepth = savedStackDepth; - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + FIXJUMP( offsetFwd); + OP4( STORE_SCALAR, dataVar); + OP( POP); if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); - TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); + OP4( JUMP_TRUE, 10); + OP4( ARRAY_MAKE_IMM, localIndex); + OP4( FOREACH_START, infoIndex); + LABEL(offsetBack); + OP4( FOREACH_STEP, infoIndex); + JUMP(offsetFwd, JUMP_FALSE); savedStackDepth = envPtr->currStackDepth; - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP1, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); + OP4( LOAD_SCALAR, keyVar); + OP4( LOAD_SCALAR, valVar); + OP4( STORE_ARRAY, localIndex); + OP( POP); + BACKJUMP( offsetBack, JUMP); + FIXJUMP( offsetFwd); envPtr->currStackDepth = savedStackDepth; } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); - TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); + OP( DUP); + OP( ARRAY_EXISTS_STK); + OP4( JUMP_TRUE, 7); + OP( DUP); + OP( ARRAY_MAKE_STK); + OP4( FOREACH_START, infoIndex); + LABEL(offsetBack); + OP4( FOREACH_STEP, infoIndex); + JUMP(offsetFwd, JUMP_FALSE); savedStackDepth = envPtr->currStackDepth; - TclEmitOpcode( INST_DUP, envPtr); - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP1, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); + OP( DUP); + OP4( LOAD_SCALAR, keyVar); + OP4( LOAD_SCALAR, valVar); + OP( STORE_ARRAY_STK); + OP( POP); + BACKJUMP( offsetBack, JUMP); + FIXJUMP( offsetFwd); envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( dataVar, envPtr); - PushLiteral(envPtr, "", 0); + OP14( UNSET_SCALAR, 0, dataVar); + PUSH( ""); return TCL_OK; } @@ -465,21 +386,20 @@ TclCompileArrayUnsetCmd( } if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 8, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 1, envPtr); - TclEmitInt4( localIndex, envPtr); + OP4( ARRAY_EXISTS_IMM, localIndex); + OP4( JUMP_FALSE, 11); + OP14( UNSET_SCALAR, 1, localIndex); } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 6, envPtr); + OP( DUP); + OP( ARRAY_EXISTS_STK); + OP4( JUMP_FALSE, 12); savedStackDepth = envPtr->currStackDepth; - TclEmitInstInt1(INST_UNSET_STK, 1, envPtr); - TclEmitInstInt1(INST_JUMP1, 3, envPtr); + OP1( UNSET_STK, 1); + OP4( JUMP, 6); envPtr->currStackDepth = savedStackDepth; - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } @@ -518,8 +438,8 @@ TclCompileBreakCmd( * Emit a break instruction. */ - TclEmitOpcode(INST_BREAK, envPtr); - PushLiteral(envPtr, "", 0); /* Evil hack! */ + OP( BREAK); + PUSH( ""); /* Evil hack! */ return TCL_OK; } @@ -640,19 +560,18 @@ TclCompileCatchCmd( * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. */ - SetLineInformation(1); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { savedStackDepth = envPtr->currStackDepth; - TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, cmdTokenPtr, interp); + BODY( cmdTokenPtr, 1); } else { - CompileTokens(envPtr, cmdTokenPtr, interp); + PUSH_SUBST_WORD(cmdTokenPtr, 1); savedStackDepth = envPtr->currStackDepth; - TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_EVAL_STK, envPtr); + OP( DUP); + OP( EVAL_STK); } /* Stack at this point: * nonsimple: script <mark> result @@ -667,14 +586,14 @@ TclCompileCatchCmd( * course, finish the catch context). */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "0", 1); - TclEmitInstInt1( INST_JUMP1, 3, envPtr); + OP( POP); + PUSH( "0"); + OP4( JUMP, 6); envPtr->currStackDepth = savedStackDepth; ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); + OP( PUSH_RETURN_CODE); ExceptionRangeEnds(envPtr, range); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); /* * Stack at this point: @@ -690,7 +609,7 @@ TclCompileCatchCmd( * and jump around the "error case" code. */ - PushLiteral(envPtr, "0", 1); + PUSH( "0"); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* Stack at this point: ?script? <mark> result TCL_OK */ @@ -702,8 +621,8 @@ TclCompileCatchCmd( envPtr->currStackDepth = savedStackDepth; ExceptionRangeTarget(envPtr, range, catchOffset); /* Stack at this point: ?script? */ - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); + OP( PUSH_RESULT); + OP( PUSH_RETURN_CODE); /* * Update the target of the jump after the "no errors" code. @@ -720,7 +639,7 @@ TclCompileCatchCmd( */ if (optsIndex != -1) { - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); + OP( PUSH_RETURN_OPTIONS); } /* @@ -728,7 +647,7 @@ TclCompileCatchCmd( */ ExceptionRangeEnds(envPtr, range); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); /* * At this point, the top of the stack is inconveniently ordered: @@ -737,17 +656,17 @@ TclCompileCatchCmd( */ if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 3, envPtr); + OP4( REVERSE, 3); } else { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); + OP( EXCH); } /* * Store the result and remove it from the stack. */ - Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( STORE_SCALAR, resultIndex); + OP( POP); /* * Stack is now ?script? ?returnOptions? returnCode. @@ -757,9 +676,9 @@ TclCompileCatchCmd( */ if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( EXCH); + OP4( STORE_SCALAR, optsIndex); + OP( POP); } dropScriptAtEnd: @@ -770,8 +689,8 @@ TclCompileCatchCmd( */ if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( EXCH); + OP( POP); } /* @@ -825,8 +744,8 @@ TclCompileContinueCmd( * Emit a continue instruction. */ - TclEmitOpcode(INST_CONTINUE, envPtr); - PushLiteral(envPtr, "", 0); /* Evil hack! */ + OP( CONTINUE); + PUSH( ""); /* Evil hack! */ return TCL_OK; } @@ -899,7 +818,7 @@ TclCompileDictSetCmd( tokenPtr = TokenAfter(varTokenPtr); numWords = parsePtr->numWords-1; for (i=1 ; i<numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); } @@ -907,8 +826,7 @@ TclCompileDictSetCmd( * Now emit the instruction to do the dict manipulation. */ - TclEmitInstInt4( INST_DICT_SET, numWords-2, envPtr); - TclEmitInt4( dictVarIndex, envPtr); + OP44( DICT_SET, numWords-2, dictVarIndex); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -988,9 +906,8 @@ TclCompileDictIncrCmd( * Emit the key and the code to actually do the increment. */ - CompileWord(envPtr, keyTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount, envPtr); - TclEmitInt4( dictVarIndex, envPtr); + PUSH_SUBST_WORD(keyTokenPtr, 3); + OP44( DICT_INCR_IMM, incrAmount, dictVarIndex); return TCL_OK; } @@ -1023,10 +940,10 @@ TclCompileDictGetCmd( */ for (i=0 ; i<numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_GET, numWords-1, envPtr); + OP4( DICT_GET, numWords-1); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -1060,10 +977,10 @@ TclCompileDictExistsCmd( */ for (i=0 ; i<numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_DICT_EXISTS, numWords-1, envPtr); + OP4( DICT_EXISTS, numWords-1); TclAdjustStackDepth(-1, envPtr); return TCL_OK; } @@ -1117,15 +1034,14 @@ TclCompileDictUnsetCmd( for (i=2 ; i<parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); } /* * Now emit the instruction to do the dict manipulation. */ - TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2, envPtr); - TclEmitInt4( dictVarIndex, envPtr); + OP44( DICT_UNSET, parsePtr->numWords-2, dictVarIndex); return TCL_OK; } @@ -1142,8 +1058,7 @@ TclCompileDictCreateCmd( int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; - const char *bytes; - int i, len; + int i; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; @@ -1183,10 +1098,9 @@ TclCompileDictCreateCmd( * We did! Excellent. The "verifyDict" is to do type forcing. */ - bytes = Tcl_GetStringFromObj(dictObj, &len); - PushLiteral(envPtr, bytes, len); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_DICT_VERIFY, envPtr); + PUSH_OBJ( dictObj); + OP( DUP); + OP( DICT_VERIFY); Tcl_DecrRefCount(dictObj); return TCL_OK; @@ -1197,28 +1111,26 @@ TclCompileDictCreateCmd( */ nonConstant: - worker = TclFindCompiledLocal(NULL, 0, 1, envPtr); + worker = NewUnnamedLocal(envPtr); if (worker < 0) { return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, worker, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH( ""); + OP4( STORE_SCALAR, worker); + OP( POP); tokenPtr = TokenAfter(parsePtr->tokenPtr); for (i=1 ; i<parsePtr->numWords ; i+=2) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i+1); + PUSH_SUBST_WORD(tokenPtr, i+1); tokenPtr = TokenAfter(tokenPtr); - TclEmitInstInt4( INST_DICT_SET, 1, envPtr); - TclEmitInt4( worker, envPtr); + OP44( DICT_SET, 1, worker); TclAdjustStackDepth(-1, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - Emit14Inst( INST_LOAD_SCALAR, worker, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( worker, envPtr); + OP4( LOAD_SCALAR, worker); + OP14( UNSET_SCALAR, 0, worker); return TCL_OK; } @@ -1241,13 +1153,13 @@ TclCompileDictMergeCmd( */ if (parsePtr->numWords < 2) { - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } else if (parsePtr->numWords == 2) { tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_DICT_VERIFY, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( DUP); + OP( DICT_VERIFY); return TCL_OK; } @@ -1258,63 +1170,64 @@ TclCompileDictMergeCmd( * command when there's an LVT present. */ - workerIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + workerIndex = NewUnnamedLocal(envPtr); if (workerIndex < 0) { return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + infoIndex = NewUnnamedLocal(envPtr); /* * Get the first dictionary and verify that it is so. */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_DICT_VERIFY, envPtr); - Emit14Inst( INST_STORE_SCALAR, workerIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( DUP); + OP( DICT_VERIFY); + OP4( STORE_SCALAR, workerIndex); + OP( POP); /* * For each of the remaining dictionaries... */ outLoop = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH4, outLoop, envPtr); + OP4( BEGIN_CATCH, outLoop); ExceptionRangeStarts(envPtr, outLoop); for (i=2 ; i<parsePtr->numWords ; i++) { + int endloop, loop; + /* * Get the dictionary, and merge its pairs into the first dict (using * a small loop). */ tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i); - TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); - TclEmitInstInt1( INST_JUMP_TRUE1, 24, envPtr); - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitInstInt4( INST_DICT_SET, 1, envPtr); - TclEmitInt4( workerIndex, envPtr); + PUSH_SUBST_WORD(tokenPtr, i); + OP4( DICT_FIRST, infoIndex); + JUMP(endloop, JUMP_TRUE); + LABEL(loop); + OP( EXCH); + OP44( DICT_SET, 1, workerIndex); TclAdjustStackDepth(-1, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); - TclEmitInstInt1( INST_JUMP_FALSE1, -20, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); + OP( POP); + OP4( DICT_NEXT, infoIndex); + BACKJUMP(loop, JUMP_FALSE); + FIXJUMP(endloop); + OP( POP); + OP( POP); + OP14( UNSET_SCALAR, 0, infoIndex); } ExceptionRangeEnds(envPtr, outLoop); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); /* * Clean up any state left over. */ - Emit14Inst( INST_LOAD_SCALAR, workerIndex, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( workerIndex, envPtr); - TclEmitInstInt1( INST_JUMP1, 18, envPtr); + OP4( LOAD_SCALAR, workerIndex); + OP14( UNSET_SCALAR, 0, workerIndex); + OP4( JUMP, 21); /* * If an exception happens when starting to iterate over the second (and @@ -1322,14 +1235,12 @@ TclCompileDictMergeCmd( */ ExceptionRangeTarget(envPtr, outLoop, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( workerIndex, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP( END_CATCH); + OP14( UNSET_SCALAR, 0, workerIndex); + OP14( UNSET_SCALAR, 0, infoIndex); + OP( RETURN_STK); return TCL_OK; } @@ -1374,9 +1285,8 @@ CompileDictEachCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; - int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; - int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - int numVars, endTargetOffset; + int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange, numVars; + int infoIndex, bodyTargetOffset, emptyTargetOffset, endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ int savedStackDepth = envPtr->currStackDepth; @@ -1407,8 +1317,7 @@ CompileDictEachCmd( */ if (collect == TCL_EACH_COLLECT) { - collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, - envPtr); + collectVar = NewUnnamedLocal(envPtr); if (collectVar < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1458,7 +1367,7 @@ CompileDictEachCmd( * (at which point it should also have been finished with). */ - infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + infoIndex = NewUnnamedLocal(envPtr); if (infoIndex < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } @@ -1471,9 +1380,9 @@ CompileDictEachCmd( */ if (collect == TCL_EACH_COLLECT) { - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH( ""); + OP4( STORE_SCALAR, collectVar); + OP( POP); } /* @@ -1481,10 +1390,9 @@ CompileDictEachCmd( * this point. */ - CompileWord(envPtr, dictTokenPtr, interp, 3); - TclEmitInstInt4( INST_DICT_FIRST, infoIndex, envPtr); - emptyTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); + PUSH_SUBST_WORD(dictTokenPtr, 3); + OP4( DICT_FIRST, infoIndex); + JUMP(emptyTargetOffset, JUMP_TRUE); /* * Now we catch errors from here on so that we can finalize the search @@ -1492,18 +1400,18 @@ CompileDictEachCmd( */ catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange, envPtr); + OP4( BEGIN_CATCH, catchRange); ExceptionRangeStarts(envPtr, catchRange); /* * Inside the iteration, write the loop variables. */ - bodyTargetOffset = CurrentOffset(envPtr); - Emit14Inst( INST_STORE_SCALAR, keyVarIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - Emit14Inst( INST_STORE_SCALAR, valueVarIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + LABEL(bodyTargetOffset); + OP4( STORE_SCALAR, keyVarIndex); + OP( POP); + OP4( STORE_SCALAR, valueVarIndex); + OP( POP); /* * Set up the loop exception targets. @@ -1516,17 +1424,15 @@ CompileDictEachCmd( * Compile the loop body itself. It should be stack-neutral. */ - SetLineInformation(3); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, 3); if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_DICT_SET, 1, envPtr); - TclEmitInt4( collectVar, envPtr); + OP4( LOAD_SCALAR, keyVarIndex); + OP( UNDER); + OP44( DICT_SET, 1, collectVar); TclAdjustStackDepth(-1, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( POP); } - TclEmitOpcode( INST_POP, envPtr); + OP( POP); /* * Both exception target ranges (error and loop) end here. @@ -1542,11 +1448,10 @@ CompileDictEachCmd( */ ExceptionRangeTarget(envPtr, loopRange, continueOffset); - TclEmitInstInt4( INST_DICT_NEXT, infoIndex, envPtr); - jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( DICT_NEXT, infoIndex); + BACKJUMP(bodyTargetOffset, JUMP_FALSE); + OP( POP); + OP( POP); /* * Now do the final cleanup for the no-error case (this is where we break @@ -1557,11 +1462,9 @@ CompileDictEachCmd( */ ExceptionRangeTarget(envPtr, loopRange, breakOffset); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - endTargetOffset = CurrentOffset(envPtr); - TclEmitInstInt4( INST_JUMP4, 0, envPtr); + OP14( UNSET_SCALAR, 0, infoIndex); + OP( END_CATCH); + JUMP(endTargetOffset, JUMP); /* * Error handler "finally" clause, which force-terminates the iteration @@ -1569,16 +1472,14 @@ CompileDictEachCmd( */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP14( UNSET_SCALAR, 0, infoIndex); + OP( END_CATCH); if (collect == TCL_EACH_COLLECT) { - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); + OP14( UNSET_SCALAR, 0, collectVar); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( RETURN_STK); /* * Otherwise we're done (the jump after the DICT_FIRST points here) and we @@ -1587,13 +1488,10 @@ CompileDictEachCmd( */ envPtr->currStackDepth = savedStackDepth + 2; - jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement, - envPtr->codeStart + emptyTargetOffset); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( infoIndex, envPtr); + FIXJUMP( emptyTargetOffset); + OP( POP); + OP( POP); + OP14( UNSET_SCALAR, 0, infoIndex); /* * Final stage of the command (normal case) is that we push an empty @@ -1601,15 +1499,12 @@ CompileDictEachCmd( * last to promote peephole optimization when it's dropped immediately. */ - jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; - TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement, - envPtr->codeStart + endTargetOffset); + FIXJUMP( endTargetOffset); if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); + OP4( LOAD_SCALAR, collectVar); + OP14( UNSET_SCALAR, 0, collectVar); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } return TCL_OK; } @@ -1729,19 +1624,17 @@ TclCompileDictUpdateCmd( infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr); for (i=0 ; i<numVars ; i++) { - CompileWord(envPtr, keyTokenPtrs[i], interp, i); + PUSH_SUBST_WORD(keyTokenPtrs[i], i); } - TclEmitInstInt4( INST_LIST, numVars, envPtr); - TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + OP4( LIST, numVars); + OP44( DICT_UPDATE_START, dictIndex, infoIndex); range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); envPtr->currStackDepth++; - SetLineInformation(parsePtr->numWords - 1); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, parsePtr->numWords - 1); envPtr->currStackDepth = savedStackDepth; ExceptionRangeEnds(envPtr, range); @@ -1750,10 +1643,9 @@ TclCompileDictUpdateCmd( * the body evaluation: swap them and finish the update code. */ - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); + OP( END_CATCH); + OP( EXCH); + OP44( DICT_UPDATE_END, dictIndex, infoIndex); /* * Jump around the exceptional termination code. @@ -1768,14 +1660,13 @@ TclCompileDictUpdateCmd( */ ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); - TclEmitInstInt4( INST_REVERSE, 3, envPtr); + OP( PUSH_RESULT); + OP( PUSH_RETURN_OPTIONS); + OP( END_CATCH); + OP4( REVERSE, 3); - TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); - TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP44( DICT_UPDATE_END, dictIndex, infoIndex); + OP( RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", @@ -1835,18 +1726,18 @@ TclCompileDictAppendCmd( tokenPtr = TokenAfter(tokenPtr); for (i=2 ; i<parsePtr->numWords ; i++) { - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { - TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr); + OP1( CONCAT, parsePtr->numWords-3); } /* * Do the concatenation. */ - TclEmitInstInt4(INST_DICT_APPEND, dictVarIndex, envPtr); + OP4( DICT_APPEND, dictVarIndex); return TCL_OK; } @@ -1887,9 +1778,9 @@ TclCompileDictLappendCmd( if (dictVarIndex < 0) { return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr); } - CompileWord(envPtr, keyTokenPtr, interp, 3); - CompileWord(envPtr, valueTokenPtr, interp, 4); - TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr); + PUSH_SUBST_WORD(keyTokenPtr, 3); + PUSH_SUBST_WORD(valueTokenPtr, 4); + OP4( DICT_LAPPEND, dictVarIndex); return TCL_OK; } @@ -1977,26 +1868,26 @@ TclCompileDictWithCmd( tokenPtr = TokenAfter(varTokenPtr); for (i=2 ; i<parsePtr->numWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + PUSH_SUBST_WORD(tokenPtr, i-1); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); - Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); - PushLiteral(envPtr, "", 0); + OP4( LIST, parsePtr->numWords-3); + OP4( LOAD_SCALAR, dictVar); + OP( UNDER); + OP( DICT_EXPAND); + OP4( DICT_RECOMBINE_IMM, dictVar); + PUSH( ""); } else { /* * Case: Direct dict in LVT with empty body. */ - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr); - PushLiteral(envPtr, "", 0); + PUSH( ""); + OP4( LOAD_SCALAR, dictVar); + PUSH( ""); + OP( DICT_EXPAND); + OP4( DICT_RECOMBINE_IMM, dictVar); + PUSH( ""); } } else { if (gotPath) { @@ -2006,30 +1897,30 @@ TclCompileDictWithCmd( tokenPtr = varTokenPtr; for (i=1 ; i<parsePtr->numWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + PUSH_SUBST_WORD(tokenPtr, i-1); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitOpcode( INST_LOAD_STK, envPtr); - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); - PushLiteral(envPtr, "", 0); + OP4( LIST, parsePtr->numWords-3); + OP( UNDER); + OP( LOAD_STK); + OP( UNDER); + OP( DICT_EXPAND); + OP( DICT_RECOMBINE_STK); + PUSH( ""); } else { /* * Case: Direct dict in non-simple var with empty body. */ - CompileWord(envPtr, varTokenPtr, interp, 0); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_LOAD_STK, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitInstInt4(INST_REVERSE, 2, envPtr); - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); - PushLiteral(envPtr, "", 0); + PUSH_SUBST_WORD(varTokenPtr, 0); + OP( DUP); + OP( LOAD_STK); + PUSH( ""); + OP( DICT_EXPAND); + PUSH( ""); + OP( EXCH); + OP( DICT_RECOMBINE_STK); + PUSH( ""); } } envPtr->currStackDepth = savedStackDepth + 1; @@ -2045,60 +1936,59 @@ TclCompileDictWithCmd( */ if (dictVar == -1) { - varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + varNameTmp = NewUnnamedLocal(envPtr); } else { varNameTmp = -1; } if (gotPath) { - pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + pathTmp = NewUnnamedLocal(envPtr); } else { pathTmp = -1; } - keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr); + keysTmp = NewUnnamedLocal(envPtr); /* * Issue instructions. First, the part to expand the dictionary. */ if (varNameTmp > -1) { - CompileWord(envPtr, varTokenPtr, interp, 0); - Emit14Inst( INST_STORE_SCALAR, varNameTmp, envPtr); + PUSH_SUBST_WORD(varTokenPtr, 0); + OP4( STORE_SCALAR, varNameTmp); } tokenPtr = TokenAfter(varTokenPtr); if (gotPath) { for (i=2 ; i<parsePtr->numWords-1 ; i++) { - CompileWord(envPtr, tokenPtr, interp, i-1); + PUSH_SUBST_WORD(tokenPtr, i-1); tokenPtr = TokenAfter(tokenPtr); } - TclEmitInstInt4( INST_LIST, parsePtr->numWords-3,envPtr); - Emit14Inst( INST_STORE_SCALAR, pathTmp, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( LIST, parsePtr->numWords-3); + OP4( STORE_SCALAR, pathTmp); + OP( POP); } if (dictVar == -1) { - TclEmitOpcode( INST_LOAD_STK, envPtr); + OP( LOAD_STK); } else { - Emit14Inst( INST_LOAD_SCALAR, dictVar, envPtr); + OP4( LOAD_SCALAR, dictVar); } if (gotPath) { - Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); + OP4( LOAD_SCALAR, pathTmp); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } - TclEmitOpcode( INST_DICT_EXPAND, envPtr); - Emit14Inst( INST_STORE_SCALAR, keysTmp, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( DICT_EXPAND); + OP4( STORE_SCALAR, keysTmp); + OP( POP); /* * Now the body of the [dict with]. */ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); envPtr->currStackDepth++; - SetLineInformation(parsePtr->numWords-1); - CompileBody(envPtr, tokenPtr, interp); + BODY( tokenPtr, parsePtr->numWords-1); envPtr->currStackDepth = savedStackDepth; ExceptionRangeEnds(envPtr, range); @@ -2106,20 +1996,20 @@ TclCompileDictWithCmd( * Now fold the results back into the dictionary in the OK case. */ - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( END_CATCH); if (varNameTmp > -1) { - Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); + OP4( LOAD_SCALAR, varNameTmp); } if (gotPath) { - Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); + OP4( LOAD_SCALAR, pathTmp); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } - Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); + OP4( LOAD_SCALAR, keysTmp); if (dictVar == -1) { - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); + OP( DICT_RECOMBINE_STK); } else { - TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); + OP4( DICT_RECOMBINE_IMM, dictVar); } TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); @@ -2128,24 +2018,24 @@ TclCompileDictWithCmd( */ ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_OPTIONS, envPtr); - TclEmitOpcode( INST_PUSH_RESULT, envPtr); - TclEmitOpcode( INST_END_CATCH, envPtr); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP( END_CATCH); if (varNameTmp > -1) { - Emit14Inst( INST_LOAD_SCALAR, varNameTmp, envPtr); + OP4( LOAD_SCALAR, varNameTmp); } if (parsePtr->numWords > 3) { - Emit14Inst( INST_LOAD_SCALAR, pathTmp, envPtr); + OP4( LOAD_SCALAR, pathTmp); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } - Emit14Inst( INST_LOAD_SCALAR, keysTmp, envPtr); + OP4( LOAD_SCALAR, keysTmp); if (dictVar == -1) { - TclEmitOpcode( INST_DICT_RECOMBINE_STK, envPtr); + OP( DICT_RECOMBINE_STK); } else { - TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); + OP4( DICT_RECOMBINE_IMM, dictVar); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + OP( RETURN_STK); /* * Prepare for the start of the next command. @@ -2259,9 +2149,9 @@ TclCompileErrorCmd( } messageTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushLiteral(envPtr, "-code error -level 0", 20); - CompileWord(envPtr, messageTokenPtr, interp, 1); - TclEmitOpcode(INST_RETURN_STK, envPtr); + PUSH( "-code error -level 0"); + PUSH_SUBST_WORD(messageTokenPtr, 1); + OP( RETURN_STK); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } @@ -2386,9 +2276,8 @@ TclCompileForCmd( * Inline compile the initial command. */ - SetLineInformation(1); - CompileBody(envPtr, startTokenPtr, interp); - TclEmitOpcode(INST_POP, envPtr); + BODY( startTokenPtr, 1); + OP( POP); /* * Jump to the evaluation of the condition. This code uses the "loop @@ -2409,11 +2298,10 @@ TclCompileForCmd( */ bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); - SetLineInformation(4); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, 4); ExceptionRangeEnds(envPtr, bodyRange); envPtr->currStackDepth = savedStackDepth + 1; - TclEmitOpcode(INST_POP, envPtr); + OP( POP); /* * Compile the "next" subcommand. @@ -2421,11 +2309,10 @@ TclCompileForCmd( envPtr->currStackDepth = savedStackDepth; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); - SetLineInformation(3); - CompileBody(envPtr, nextTokenPtr, interp); + BODY( nextTokenPtr, 3); ExceptionRangeEnds(envPtr, nextRange); envPtr->currStackDepth = savedStackDepth + 1; - TclEmitOpcode(INST_POP, envPtr); + OP( POP); envPtr->currStackDepth = savedStackDepth; /* @@ -2433,7 +2320,7 @@ TclCompileForCmd( * terminates the for. */ - testCodeOffset = CurrentOffset(envPtr); + LABEL( testCodeOffset); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { @@ -2442,17 +2329,11 @@ TclCompileForCmd( testCodeOffset += 3; } - SetLineInformation(2); envPtr->currStackDepth = savedStackDepth; - TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + PUSH_EXPR_WORD(testTokenPtr, 2); envPtr->currStackDepth = savedStackDepth + 1; - jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; - if (jumpDist > 127) { - TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr); - } else { - TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr); - } + BACKJUMP( bodyCodeOffset, JUMP_TRUE); /* * Fix the starting points of the exception ranges (may have moved due to @@ -2472,7 +2353,7 @@ TclCompileForCmd( */ envPtr->currStackDepth = savedStackDepth; - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } @@ -2549,9 +2430,8 @@ CompileEachloopCmd( * index. */ Tcl_Token *tokenPtr, *bodyTokenPtr; - unsigned char *jumpPc; JumpFixup jumpFalseFixup; - int jumpBackDist, jumpBackOffset, infoIndex, range, bodyIndex; + int infoIndex, range, bodyIndex; int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; int savedStackDepth = envPtr->currStackDepth; DefineLineInformation; /* TIP #280 */ @@ -2664,8 +2544,7 @@ CompileEachloopCmd( } if (collect == TCL_EACH_COLLECT) { - collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, - envPtr); + collectVar = NewUnnamedLocal(envPtr); if (collectVar < 0) { return TCL_ERROR; } @@ -2684,14 +2563,12 @@ CompileEachloopCmd( code = TCL_OK; firstValueTemp = -1; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, envPtr); + tempVar = NewUnnamedLocal(envPtr); if (loopIndex == 0) { firstValueTemp = tempVar; } } - loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, - /*create*/ 1, envPtr); + loopCtTemp = NewUnnamedLocal(envPtr); /* * Create and initialize the ForeachInfo and ForeachVarList data @@ -2737,11 +2614,10 @@ CompileEachloopCmd( i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { - SetLineInformation(i); - CompileTokens(envPtr, tokenPtr, interp); + PUSH_SUBST_WORD(tokenPtr, i); tempVar = (firstValueTemp + loopIndex); - Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4(STORE_SCALAR, tempVar); + OP( POP); loopIndex++; } } @@ -2751,16 +2627,16 @@ CompileEachloopCmd( */ if (collect == TCL_EACH_COLLECT) { - PushLiteral(envPtr, "", 0); - Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH( ""); + OP4( STORE_SCALAR, collectVar); + OP( POP); } /* * Initialize the temporary var that holds the count of loop iterations. */ - TclEmitInstInt4( INST_FOREACH_START4, infoIndex, envPtr); + OP4( FOREACH_START, infoIndex); /* * Top of loop code: assign each loop variable and check whether @@ -2768,23 +2644,22 @@ CompileEachloopCmd( */ ExceptionRangeTarget(envPtr, range, continueOffset); - TclEmitInstInt4( INST_FOREACH_STEP4, infoIndex, envPtr); + OP4( FOREACH_STEP, infoIndex); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); /* * Inline compile the loop body. */ - SetLineInformation(bodyIndex); ExceptionRangeStarts(envPtr, range); - CompileBody(envPtr, bodyTokenPtr, interp); + BODY( bodyTokenPtr, bodyIndex); ExceptionRangeEnds(envPtr, range); envPtr->currStackDepth = savedStackDepth + 1; if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr); + OP4( LAPPEND_SCALAR, collectVar); } - TclEmitOpcode( INST_POP, envPtr); + OP( POP); /* * Jump back to the test at the top of the loop. Generate a 4 byte jump if @@ -2793,13 +2668,7 @@ CompileEachloopCmd( * replace the ifFalse jump with a 4 byte jump. */ - jumpBackOffset = CurrentOffset(envPtr); - jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset; - if (jumpBackDist > 120) { - TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr); - } else { - TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr); - } + BACKJUMP(envPtr->exceptArrayPtr[range].continueOffset, JUMP); /* * Fix the target of the jump after the foreach_step test. @@ -2811,20 +2680,6 @@ CompileEachloopCmd( */ envPtr->exceptArrayPtr[range].codeOffset += 3; - - /* - * Update the jump back to the test at the top of the loop since it - * also moved down 3 bytes. - */ - - jumpBackOffset += 3; - jumpPc = (envPtr->codeStart + jumpBackOffset); - jumpBackDist += 3; - if (jumpBackDist > 120) { - TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc); - } else { - TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc); - } } /* @@ -2840,11 +2695,10 @@ CompileEachloopCmd( envPtr->currStackDepth = savedStackDepth; if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); + OP4( LOAD_SCALAR, collectVar); + OP14( UNSET_SCALAR, 0, collectVar); } else { - PushLiteral(envPtr, "", 0); + PUSH( ""); } envPtr->currStackDepth = savedStackDepth + 1; @@ -3089,8 +2943,7 @@ TclCompileFormatCmd( * literal. Job done. */ - bytes = Tcl_GetStringFromObj(tmpObj, &len); - PushLiteral(envPtr, bytes, len); + PUSH_OBJ(tmpObj); Tcl_DecrRefCount(tmpObj); return TCL_OK; @@ -3160,7 +3013,7 @@ TclCompileFormatCmd( if (*++bytes == '%') { Tcl_AppendToObj(tmpObj, "%", 1); } else { - char *b = Tcl_GetStringFromObj(tmpObj, &len); + (void) Tcl_GetStringFromObj(tmpObj, &len); /* * If there is a non-empty literal from the format string, @@ -3168,7 +3021,7 @@ TclCompileFormatCmd( */ if (len > 0) { - PushLiteral(envPtr, b, len); + PUSH_OBJ(tmpObj); Tcl_DecrRefCount(tmpObj); tmpObj = Tcl_NewObj(); i++; @@ -3180,7 +3033,7 @@ TclCompileFormatCmd( * directly. */ - CompileWord(envPtr, tokenPtr, interp, j); + PUSH_SUBST_WORD(tokenPtr, j); tokenPtr = TokenAfter(tokenPtr); j++; i++; @@ -3194,9 +3047,9 @@ TclCompileFormatCmd( */ Tcl_AppendToObj(tmpObj, start, bytes - start); - bytes = Tcl_GetStringFromObj(tmpObj, &len); + (void) Tcl_GetStringFromObj(tmpObj, &len); if (len > 0) { - PushLiteral(envPtr, bytes, len); + PUSH_OBJ(tmpObj); i++; } Tcl_DecrRefCount(tmpObj); @@ -3207,7 +3060,7 @@ TclCompileFormatCmd( * Do the concatenation, which produces the result. */ - TclEmitInstInt1(INST_CONCAT1, i, envPtr); + OP1( CONCAT, i); } else { /* * EVIL HACK! Force there to be a string representation in the case @@ -3215,10 +3068,10 @@ TclCompileFormatCmd( * format-20.1 (and it is horrible...) */ - TclEmitOpcode(INST_DUP, envPtr); - PushLiteral(envPtr, "", 0); - TclEmitOpcode(INST_STR_EQ, envPtr); - TclEmitOpcode(INST_POP, envPtr); + OP( DUP); + PUSH( ""); + OP( STR_EQ); + OP( POP); } return TCL_OK; } @@ -3268,10 +3121,10 @@ TclCompileGlobalCmd( } /* - * Push the namespace + * Push the namespace. */ - PushLiteral(envPtr, "::", 2); + PUSH( "::"); /* * Loop over the variables. @@ -3285,16 +3138,16 @@ TclCompileGlobalCmd( return TCL_ERROR; } - CompileWord(envPtr, varTokenPtr, interp, 1); - TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); + PUSH_SUBST_WORD(varTokenPtr, 1); + OP4( NSUPVAR, localIndex); } /* * Pop the namespace, and set the result to empty */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( POP); + PUSH( ""); return TCL_OK; } @@ -3421,9 +3274,8 @@ TclCompileIfCmd( compileScripts = 0; } } else { - SetLineInformation(wordIdx); Tcl_ResetResult(interp); - TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + PUSH_EXPR_WORD(testTokenPtr, wordIdx); if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { TclExpandJumpFixupArray(&jumpFalseFixupArray); } @@ -3463,9 +3315,8 @@ TclCompileIfCmd( */ if (compileScripts) { - SetLineInformation(wordIdx); envPtr->currStackDepth = savedStackDepth; - CompileBody(envPtr, tokenPtr, interp); + BODY( tokenPtr, wordIdx); } if (realCond) { @@ -3551,8 +3402,7 @@ TclCompileIfCmd( * Compile the else command body. */ - SetLineInformation(wordIdx); - CompileBody(envPtr, tokenPtr, interp); + BODY(tokenPtr, wordIdx); } /* @@ -3570,7 +3420,7 @@ TclCompileIfCmd( */ if (compileScripts) { - PushLiteral(envPtr, "", 0); + PUSH( ""); } } @@ -3591,11 +3441,7 @@ TclCompileIfCmd( + jumpFalseFixupArray.fixup[jumpIndex].codeOffset; unsigned char opCode = *ifFalsePc; - if (opCode == INST_JUMP_FALSE1) { - jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1); - jumpFalseDist += 3; - TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1)); - } else if (opCode == INST_JUMP_FALSE4) { + if (opCode == INST_JUMP_FALSE) { jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1); jumpFalseDist += 3; TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1)); @@ -3652,9 +3498,8 @@ TclCompileIncrCmd( } varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * If an increment is given, push it, but see first if it's a small @@ -3681,8 +3526,7 @@ TclCompileIncrCmd( PushLiteral(envPtr, word, numBytes); } } else { - SetLineInformation(2); - CompileTokens(envPtr, incrTokenPtr, interp); + PUSH_SUBST_WORD(incrTokenPtr, 2); } } else { /* No incr amount given so use 1. */ haveImmValue = 1; @@ -3694,38 +3538,36 @@ TclCompileIncrCmd( if (!simpleVarName) { if (haveImmValue) { - TclEmitInstInt1( INST_INCR_STK_IMM, immValue, envPtr); + OP1( INCR_STK_IMM, immValue); } else { - TclEmitOpcode( INST_INCR_STK, envPtr); + OP( INCR_STK); } } else if (isScalar) { /* Simple scalar variable. */ if (localIndex >= 0) { if (haveImmValue) { - TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr); - TclEmitInt1(immValue, envPtr); + OP41( INCR_SCALAR_IMM, localIndex, immValue); } else { - TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr); + OP4( INCR_SCALAR, localIndex); } } else { if (haveImmValue) { - TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr); + OP1( INCR_STK_IMM, immValue); } else { - TclEmitOpcode( INST_INCR_SCALAR_STK, envPtr); + OP( INCR_STK); } } } else { /* Simple array variable. */ if (localIndex >= 0) { if (haveImmValue) { - TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr); - TclEmitInt1(immValue, envPtr); + OP41( INCR_ARRAY_IMM, localIndex, immValue); } else { - TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr); + OP4( INCR_ARRAY, localIndex); } } else { if (haveImmValue) { - TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr); + OP1( INCR_ARRAY_STK_IMM, immValue); } else { - TclEmitOpcode( INST_INCR_ARRAY_STK, envPtr); + OP( INCR_ARRAY_STK); } } } @@ -3798,12 +3640,12 @@ TclCompileInfoCommandsCmd( * that the result needs to be list-ified. */ - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_STR_LEN, envPtr); - TclEmitInstInt1( INST_JUMP_FALSE1, 7, envPtr); - TclEmitInstInt4( INST_LIST, 1, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( RESOLVE_COMMAND); + OP( DUP); + OP( STR_LEN); + OP4( JUMP_FALSE, 10); + OP4( LIST, 1); return TCL_OK; notCompilable: @@ -3832,7 +3674,7 @@ TclCompileInfoCoroutineCmd( * Not much to do; we compile to a single instruction... */ - TclEmitOpcode( INST_COROUTINE_NAME, envPtr); + OP( COROUTINE_NAME); return TCL_OK; } @@ -3862,26 +3704,26 @@ TclCompileInfoExistsCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, 1); + PUSH_VAR( tokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * Emit instruction to check the variable for existence. */ if (!simpleVarName) { - TclEmitOpcode( INST_EXIST_STK, envPtr); + OP( EXIST_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_EXIST_STK, envPtr); + OP( EXIST_STK); } else { - TclEmitInstInt4( INST_EXIST_SCALAR, localIndex, envPtr); + OP4(EXIST_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_EXIST_ARRAY_STK, envPtr); + OP( EXIST_ARRAY_STK); } else { - TclEmitInstInt4( INST_EXIST_ARRAY, localIndex, envPtr); + OP4(EXIST_ARRAY, localIndex); } } @@ -3906,7 +3748,7 @@ TclCompileInfoLevelCmd( * Not much to do; we compile to a single instruction... */ - TclEmitOpcode( INST_INFO_LEVEL_NUM, envPtr); + OP( INFO_LEVEL_NUM); } else if (parsePtr->numWords != 2) { return TCL_ERROR; } else { @@ -3917,9 +3759,8 @@ TclCompileInfoLevelCmd( * list of arguments. */ - SetLineInformation(1); - CompileTokens(envPtr, TokenAfter(parsePtr->tokenPtr), interp); - TclEmitOpcode( INST_INFO_LEVEL_ARGS, envPtr); + PUSH_SUBST_WORD(TokenAfter(parsePtr->tokenPtr), 1); + OP( INFO_LEVEL_ARGS); } return TCL_OK; } @@ -3939,8 +3780,8 @@ TclCompileInfoObjectClassCmd( if (parsePtr->numWords != 2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_TCLOO_CLASS, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( TCLOO_CLASS); return TCL_OK; } @@ -3975,8 +3816,8 @@ TclCompileInfoObjectIsACmd( * Issue the code. */ - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode( INST_TCLOO_IS_OBJECT, envPtr); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( TCLOO_IS_OBJECT); return TCL_OK; } @@ -3995,8 +3836,8 @@ TclCompileInfoObjectNamespaceCmd( if (parsePtr->numWords != 2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitOpcode( INST_TCLOO_NS, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP( TCLOO_NS); return TCL_OK; } @@ -4060,9 +3901,8 @@ TclCompileLappendCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * If we are doing an assignment, push the new value. In the no values @@ -4070,9 +3910,7 @@ TclCompileLappendCmd( */ if (numWords > 2) { - Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr); - - CompileWord(envPtr, valueTokenPtr, interp, 2); + PUSH_SUBST_WORD(TokenAfter(varTokenPtr), 2); } /* @@ -4085,18 +3923,18 @@ TclCompileLappendCmd( */ if (!simpleVarName) { - TclEmitOpcode( INST_LAPPEND_STK, envPtr); + OP( LAPPEND_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_LAPPEND_STK, envPtr); + OP( LAPPEND_STK); } else { - Emit14Inst( INST_LAPPEND_SCALAR, localIndex, envPtr); + OP4(LAPPEND_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_LAPPEND_ARRAY_STK, envPtr); + OP( LAPPEND_ARRAY_STK); } else { - Emit14Inst( INST_LAPPEND_ARRAY, localIndex, envPtr); + OP4(LAPPEND_ARRAY, localIndex); } } @@ -4149,7 +3987,7 @@ TclCompileLassignCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); /* * Generate code to assign values from the list to variables. @@ -4162,8 +4000,8 @@ TclCompileLassignCmd( * Generate the next variable name. */ - PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, - &simpleVarName, &isScalar, idx+2); + PUSH_VAR( tokenPtr, idx+2, + &localIndex, &simpleVarName, &isScalar); /* * Emit instructions to get the idx'th item out of the list value on @@ -4171,33 +4009,33 @@ TclCompileLassignCmd( */ if (!simpleVarName) { - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( UNDER); + OP4( LIST_INDEX_IMM, idx); + OP( STORE_STK); + OP( POP); } else if (isScalar) { if (localIndex >= 0) { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( DUP); + OP4( LIST_INDEX_IMM, idx); + OP4( STORE_SCALAR, localIndex); + OP( POP); } else { - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( UNDER); + OP4( LIST_INDEX_IMM, idx); + OP( STORE_SCALAR_STK); + OP( POP); } } else { if (localIndex >= 0) { - TclEmitInstInt4(INST_OVER, 1, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP( UNDER); + OP4( LIST_INDEX_IMM, idx); + OP4( STORE_ARRAY, localIndex); + OP( POP); } else { - TclEmitInstInt4(INST_OVER, 2, envPtr); - TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); + OP4( OVER, 2); + OP4( LIST_INDEX_IMM, idx); + OP( STORE_ARRAY_STK); + OP( POP); } } } @@ -4206,9 +4044,7 @@ TclCompileLassignCmd( * Generate code to leave the rest of the list on the stack. */ - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( -2 /* == "end" */, envPtr); - + OP44( LIST_RANGE_IMM, idx, -2 /* == "end" */); return TCL_OK; } @@ -4285,8 +4121,8 @@ TclCompileLindexCmd( * by an "immediate lindex" which is the most efficient variety. */ - CompileWord(envPtr, valTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); + PUSH_SUBST_WORD(valTokenPtr, 1); + OP4(LIST_INDEX_IMM, idx); return TCL_OK; } @@ -4302,7 +4138,7 @@ TclCompileLindexCmd( emitComplexLindex: for (i=1 ; i<numWords ; i++) { - CompileWord(envPtr, valTokenPtr, interp, i); + PUSH_SUBST_WORD(valTokenPtr, i); valTokenPtr = TokenAfter(valTokenPtr); } @@ -4312,9 +4148,9 @@ TclCompileLindexCmd( */ if (numWords == 3) { - TclEmitOpcode( INST_LIST_INDEX, envPtr); + OP( LIST_INDEX); } else { - TclEmitInstInt4( INST_LIST_INDEX_MULTI, numWords-1, envPtr); + OP4( LIST_INDEX_MULTI, numWords-1); } return TCL_OK; @@ -4364,7 +4200,7 @@ TclCompileListCmd( * [list] without arguments just pushes an empty object. */ - PushLiteral(envPtr, "", 0); + PUSH( ""); } else { /* * Push the all values onto the stack. @@ -4373,10 +4209,10 @@ TclCompileListCmd( numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { - CompileWord(envPtr, valueTokenPtr, interp, i); + PUSH_SUBST_WORD(valueTokenPtr, i); valueTokenPtr = TokenAfter(valueTokenPtr); } - TclEmitInstInt4( INST_LIST, numWords - 1, envPtr); + OP4( LIST, numWords-1); } return TCL_OK; @@ -4417,8 +4253,8 @@ TclCompileLlengthCmd( } varTokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, varTokenPtr, interp, 1); - TclEmitOpcode( INST_LIST_LENGTH, envPtr); + PUSH_SUBST_WORD(varTokenPtr, 1); + OP( LIST_LENGTH); return TCL_OK; } @@ -4512,9 +4348,8 @@ TclCompileLrangeCmd( * is worth trying to do that given current knowledge. */ - CompileWord(envPtr, listTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); + PUSH_SUBST_WORD(listTokenPtr, 1); + OP44( LIST_RANGE_IMM, idx1, idx2); return TCL_OK; } @@ -4630,14 +4465,13 @@ TclCompileLreplaceCmd( * is worth trying to do that given current knowledge. */ - CompileWord(envPtr, listTokenPtr, interp, 1); + PUSH_SUBST_WORD(listTokenPtr, 1); if (guaranteedDropAll) { - TclEmitOpcode( INST_LIST_LENGTH, envPtr); - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( LIST_LENGTH); + OP( POP); + PUSH( ""); } else { - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); + OP44( LIST_RANGE_IMM, idx1, idx2); } return TCL_OK; } @@ -4722,8 +4556,8 @@ TclCompileLsetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * Push the "index" args and the new element value. @@ -4731,7 +4565,7 @@ TclCompileLsetCmd( for (i=2 ; i<parsePtr->numWords ; ++i) { varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, i); + PUSH_SUBST_WORD(varTokenPtr, i); } /* @@ -4744,7 +4578,7 @@ TclCompileLsetCmd( } else { tempDepth = parsePtr->numWords - 1; } - TclEmitInstInt4( INST_OVER, tempDepth, envPtr); + OP4( OVER, tempDepth); } /* @@ -4757,7 +4591,7 @@ TclCompileLsetCmd( } else { tempDepth = parsePtr->numWords - 2; } - TclEmitInstInt4( INST_OVER, tempDepth, envPtr); + OP4( OVER, tempDepth); } /* @@ -4765,18 +4599,18 @@ TclCompileLsetCmd( */ if (!simpleVarName) { - TclEmitOpcode( INST_LOAD_STK, envPtr); + OP( LOAD_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_LOAD_SCALAR_STK, envPtr); + OP( LOAD_SCALAR_STK); } else { - Emit14Inst( INST_LOAD_SCALAR, localIndex, envPtr); + OP4(LOAD_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_LOAD_ARRAY_STK, envPtr); + OP( LOAD_ARRAY_STK); } else { - Emit14Inst( INST_LOAD_ARRAY, localIndex, envPtr); + OP4(LOAD_ARRAY, localIndex); } } @@ -4785,9 +4619,9 @@ TclCompileLsetCmd( */ if (parsePtr->numWords == 4) { - TclEmitOpcode( INST_LSET_LIST, envPtr); + OP( LSET_LIST); } else { - TclEmitInstInt4( INST_LSET_FLAT, parsePtr->numWords-1, envPtr); + OP4( LSET_FLAT, parsePtr->numWords-1); } /* @@ -4795,18 +4629,18 @@ TclCompileLsetCmd( */ if (!simpleVarName) { - TclEmitOpcode( INST_STORE_STK, envPtr); + OP( STORE_STK); } else if (isScalar) { if (localIndex < 0) { - TclEmitOpcode( INST_STORE_SCALAR_STK, envPtr); + OP( STORE_SCALAR_STK); } else { - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); + OP4(STORE_SCALAR, localIndex); } } else { if (localIndex < 0) { - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); + OP( STORE_ARRAY_STK); } else { - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); + OP4(STORE_ARRAY, localIndex); } } @@ -4885,7 +4719,7 @@ TclCompileNamespaceCurrentCmd( * Not much to do; we compile to a single instruction... */ - TclEmitOpcode( INST_NS_CURRENT, envPtr); + OP( NS_CURRENT); return TCL_OK; } @@ -4931,11 +4765,11 @@ TclCompileNamespaceCodeCmd( * the value needs to be determined at runtime for safety. */ - PushLiteral(envPtr, "::namespace", 11); - PushLiteral(envPtr, "inscope", 7); - TclEmitOpcode( INST_NS_CURRENT, envPtr); - CompileWord(envPtr, tokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST, 4, envPtr); + PUSH( "::namespace"); + PUSH( "inscope"); + OP( NS_CURRENT); + PUSH_SUBST_WORD(tokenPtr, 1); + OP4( LIST, 4); return TCL_OK; } @@ -4956,22 +4790,21 @@ TclCompileNamespaceQualifiersCmd( return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); - PushLiteral(envPtr, "0", 1); - PushLiteral(envPtr, "::", 2); - TclEmitInstInt4( INST_OVER, 2, envPtr); - TclEmitOpcode( INST_STR_FIND_LAST, envPtr); - off = CurrentOffset(envPtr); - PushLiteral(envPtr, "1", 1); - TclEmitOpcode( INST_SUB, envPtr); - TclEmitInstInt4( INST_OVER, 2, envPtr); - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitOpcode( INST_STR_INDEX, envPtr); - PushLiteral(envPtr, ":", 1); - TclEmitOpcode( INST_STR_EQ, envPtr); - off = off - CurrentOffset(envPtr); - TclEmitInstInt1( INST_JUMP_TRUE1, off, envPtr); - TclEmitOpcode( INST_STR_RANGE, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + PUSH( "0"); + PUSH( "::"); + OP4( OVER, 2); + OP( STR_FIND_LAST); + LABEL(off); + PUSH( "1"); + OP( SUB); + OP4( OVER, 2); + OP( UNDER); + OP( STR_INDEX); + PUSH( ":"); + OP( STR_EQ); + BACKJUMP(off, JUMP_TRUE); + OP( STR_RANGE); return TCL_OK; } @@ -4996,19 +4829,19 @@ TclCompileNamespaceTailCmd( * Take care; only add 2 to found index if the string was actually found. */ - CompileWord(envPtr, tokenPtr, interp, 1); - PushLiteral(envPtr, "::", 2); - TclEmitInstInt4( INST_OVER, 1, envPtr); - TclEmitOpcode( INST_STR_FIND_LAST, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - PushLiteral(envPtr, "0", 1); - TclEmitOpcode( INST_GE, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + PUSH( "::"); + OP( UNDER); + OP( STR_FIND_LAST); + OP( DUP); + PUSH( "0"); + OP( GE); TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup); - PushLiteral(envPtr, "2", 1); - TclEmitOpcode( INST_ADD, envPtr); + PUSH( "2"); + OP( ADD); TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127); - PushLiteral(envPtr, "end", 3); - TclEmitOpcode( INST_STR_RANGE, envPtr); + PUSH( "end"); + OP( STR_RANGE); return TCL_OK; } @@ -5043,7 +4876,7 @@ TclCompileNamespaceUpvarCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); /* * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a @@ -5056,22 +4889,22 @@ TclCompileNamespaceUpvarCmd( otherTokenPtr = TokenAfter(localTokenPtr); localTokenPtr = TokenAfter(otherTokenPtr); - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_SUBST_WORD(otherTokenPtr, i-1); + PUSH_VAR(localTokenPtr, i, + &localIndex, &simpleVarName, &isScalar); if ((localIndex < 0) || !isScalar) { return TCL_ERROR; } - TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr); + OP4( NSUPVAR, localIndex); } /* * Pop the namespace, and set the result to empty */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( POP); + PUSH( ""); return TCL_OK; } @@ -5116,8 +4949,8 @@ TclCompileNamespaceWhichCmd( * Issue the bytecode. */ - CompileWord(envPtr, tokenPtr, interp, idx); - TclEmitOpcode( INST_RESOLVE_COMMAND, envPtr); + PUSH_SUBST_WORD(tokenPtr, idx); + OP( RESOLVE_COMMAND); return TCL_OK; } @@ -5237,7 +5070,7 @@ TclCompileRegexpCmd( * The semantics of regexp are always match on re == "". */ - PushLiteral(envPtr, "1", 1); + PUSH( "1"); return TCL_OK; } @@ -5249,13 +5082,13 @@ TclCompileRegexpCmd( if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact) == TCL_OK) { simple = 1; - PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds)); + PUSH_DSTRING(&ds); Tcl_DStringFree(&ds); } } if (!simple) { - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2); + PUSH_SUBST_WORD(varTokenPtr, parsePtr->numWords-2); } /* @@ -5263,13 +5096,13 @@ TclCompileRegexpCmd( */ varTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1); + PUSH_SUBST_WORD(varTokenPtr, parsePtr->numWords-1); if (simple) { if (exact && !nocase) { - TclEmitOpcode( INST_STR_EQ, envPtr); + OP( STR_EQ); } else { - TclEmitInstInt1( INST_STR_MATCH, nocase, envPtr); + OP1(STR_MATCH, nocase); } } else { /* @@ -5280,7 +5113,7 @@ TclCompileRegexpCmd( int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0); - TclEmitInstInt1( INST_REGEXP, cflags, envPtr); + OP1( REGEXP, cflags); } return TCL_OK; @@ -5444,10 +5277,9 @@ TclCompileRegsubCmd( result = TCL_OK; bytes = Tcl_DStringValue(&pattern) + 1; PushLiteral(envPtr, bytes, len); - bytes = Tcl_GetStringFromObj(replacementObj, &len); - PushLiteral(envPtr, bytes, len); - CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2); - TclEmitOpcode( INST_STR_MAP, envPtr); + PUSH_OBJ(replacementObj); + PUSH_SUBST_WORD(stringTokenPtr, parsePtr->numWords-2); + OP( STR_MAP); done: Tcl_DStringFree(&pattern); @@ -5515,9 +5347,9 @@ TclCompileReturnCmd( Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr); Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr); - CompileWord(envPtr, optsTokenPtr, interp, 2); - CompileWord(envPtr, msgTokenPtr, interp, 3); - TclEmitOpcode(INST_RETURN_STK, envPtr); + PUSH_SUBST_WORD(optsTokenPtr, 2); + PUSH_SUBST_WORD(msgTokenPtr, 3); + OP( RETURN_STK); envPtr->currStackDepth = savedStackDepth + 1; return TCL_OK; } @@ -5568,13 +5400,13 @@ TclCompileReturnCmd( */ if (explicitResult) { - CompileWord(envPtr, wordTokenPtr, interp, numWords-1); + PUSH_SUBST_WORD(wordTokenPtr, numWords-1); } else { /* * No explict result argument, so default result is empty string. */ - PushLiteral(envPtr, "", 0); + PUSH( ""); } /* @@ -5608,7 +5440,7 @@ TclCompileReturnCmd( */ Tcl_DecrRefCount(returnOpts); - TclEmitOpcode(INST_DONE, envPtr); + OP( DONE); return TCL_OK; } } @@ -5722,14 +5554,14 @@ TclCompileUpvarCmd( if (numWords%2) { return TCL_ERROR; } - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); otherTokenPtr = TokenAfter(tokenPtr); i = 4; } else { if (!(numWords%2)) { return TCL_ERROR; } - PushLiteral(envPtr, "1", 1); + PUSH( "1"); otherTokenPtr = tokenPtr; i = 3; } @@ -5747,22 +5579,22 @@ TclCompileUpvarCmd( for (; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) { localTokenPtr = TokenAfter(otherTokenPtr); - CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarNameWord(interp, localTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_SUBST_WORD(otherTokenPtr, 1); + PUSH_VAR(localTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); if ((localIndex < 0) || !isScalar) { return TCL_ERROR; } - TclEmitInstInt4( INST_UPVAR, localIndex, envPtr); + OP4( UPVAR, localIndex); } /* * Pop the frame index, and set the result to empty */ - TclEmitOpcode( INST_POP, envPtr); - PushLiteral(envPtr, "", 0); + OP( POP); + PUSH( ""); return TCL_OK; } @@ -5825,17 +5657,17 @@ TclCompileVariableCmd( return TCL_ERROR; } - CompileWord(envPtr, varTokenPtr, interp, i); - TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr); + PUSH_SUBST_WORD(varTokenPtr, i-1); + OP4( VARIABLE, localIndex); if (i+1 < numWords) { /* * A value has been given: set the variable, pop the value */ - CompileWord(envPtr, valueTokenPtr, interp, i+1); - Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + PUSH_SUBST_WORD(valueTokenPtr, i); + OP4(STORE_SCALAR, localIndex); + OP( POP); } } @@ -5843,7 +5675,7 @@ TclCompileVariableCmd( * Set the result to empty */ - PushLiteral(envPtr, "", 0); + PUSH( ""); return TCL_OK; } @@ -5987,7 +5819,7 @@ TclCompileObjectSelfCmd( * This delegates the entire problem to a single opcode. */ - TclEmitOpcode( INST_TCLOO_SELF, envPtr); + OP( TCLOO_SELF); return TCL_OK; compileSelfNamespace: @@ -6000,250 +5832,9 @@ TclCompileObjectSelfCmd( * avoids creating another opcode, so that's all good! */ - TclEmitOpcode( INST_TCLOO_SELF, envPtr); - TclEmitOpcode( INST_POP, envPtr); - TclEmitOpcode( INST_NS_CURRENT, envPtr); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * PushVarName -- - * - * Procedure used in the compiling where pushing a variable name is - * necessary (append, lappend, set). - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "set" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -static int -PushVarName( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Token *varTokenPtr, /* Points to a variable token. */ - CompileEnv *envPtr, /* Holds resulting instructions. */ - int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ - int *localIndexPtr, /* Must not be NULL. */ - int *simpleVarNamePtr, /* Must not be NULL. */ - int *isScalarPtr, /* Must not be NULL. */ - int line, /* Line the token starts on. */ - int *clNext) /* Reference to offset of next hidden cont. - * line. */ -{ - register const char *p; - const char *name, *elName; - register int i, n; - Tcl_Token *elemTokenPtr = NULL; - int nameChars, elNameChars, simpleVarName, localIndex; - int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; - - /* - * Decide if we can use a frame slot for the var/array name or if we need - * to emit code to compute and push the name at runtime. We use a frame - * slot (entry in the array of local vars) if we are compiling a procedure - * body and if the name is simple text that does not include namespace - * qualifiers. - */ - - simpleVarName = 0; - name = elName = NULL; - nameChars = elNameChars = 0; - localIndex = -1; - - /* - * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether - * curly braces surround the variable name. This really matters for array - * elements to handle things like - * set {x($foo)} 5 - * which raises an undefined var error if we are not careful here. - */ - - if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && - (varTokenPtr->start[0] != '{')) { - /* - * A simple variable name. Divide it up into "name" and "elName" - * strings. If it is not a local variable, look it up at runtime. - */ - - simpleVarName = 1; - - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (name[nameChars-1] == ')') { - /* - * last char is ')' => potential array reference. - */ - - for (i=0,p=name ; i<nameChars ; i++,p++) { - if (*p == '(') { - elName = p + 1; - elNameChars = nameChars - i - 2; - nameChars = i; - break; - } - } - - if ((elName != NULL) && elNameChars) { - /* - * An array element, the element name is a simple string: - * assemble the corresponding token. - */ - - elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = elNameChars; - elemTokenPtr->numComponents = 0; - elemTokenCount = 1; - } - } - } else if (((n = varTokenPtr->numComponents) > 1) - && (varTokenPtr[1].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { - /* - * Check for parentheses inside first token. - */ - - simpleVarName = 0; - for (i = 0, p = varTokenPtr[1].start; - i < varTokenPtr[1].size; i++, p++) { - if (*p == '(') { - simpleVarName = 1; - break; - } - } - if (simpleVarName) { - int remainingChars; - - /* - * Check the last token: if it is just ')', do not count it. - * Otherwise, remove the ')' and flag so that it is restored at - * the end. - */ - - if (varTokenPtr[n].size == 1) { - n--; - } else { - varTokenPtr[n].size--; - removedParen = n; - } - - name = varTokenPtr[1].start; - nameChars = p - varTokenPtr[1].start; - elName = p + 1; - remainingChars = (varTokenPtr[2].start - p) - 1; - elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2; - - if (remainingChars) { - /* - * Make a first token with the extra characters in the first - * token. - */ - - elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = remainingChars; - elemTokenPtr->numComponents = 0; - elemTokenCount = n; - - /* - * Copy the remaining tokens. - */ - - memcpy(elemTokenPtr+1, varTokenPtr+2, - (n-1) * sizeof(Tcl_Token)); - } else { - /* - * Use the already available tokens. - */ - - elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; - } - } - } - - if (simpleVarName) { - /* - * See whether name has any namespace separators (::'s). - */ - - int hasNsQualifiers = 0; - - for (i = 0, p = name; i < nameChars; i++, p++) { - if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) { - hasNsQualifiers = 1; - break; - } - } - - /* - * Look up the var name's index in the array of local vars in the proc - * frame. If retrieving the var's value and it doesn't already exist, - * push its name and look it up at runtime. - */ - - if (!hasNsQualifiers) { - localIndex = TclFindCompiledLocal(name, nameChars, - 1, envPtr); - if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { - /* - * We'll push the name. - */ - - localIndex = -1; - } - } - if (localIndex < 0) { - PushLiteral(envPtr, name, nameChars); - } - - /* - * Compile the element script, if any, and only if not inhibited. [Bug - * 3600328] - */ - - if (elName != NULL && !(flags & TCL_NO_ELEMENT)) { - if (elNameChars) { - envPtr->line = line; - envPtr->clNext = clNext; - TclCompileTokens(interp, elemTokenPtr, elemTokenCount, - envPtr); - } else { - PushLiteral(envPtr, "", 0); - } - } - } else { - /* - * The var name isn't simple: compile and push it. - */ - - envPtr->line = line; - envPtr->clNext = clNext; - CompileTokens(envPtr, varTokenPtr, interp); - } - - if (removedParen) { - varTokenPtr[removedParen].size++; - } - if (allocedTokens) { - TclStackFree(interp, elemTokenPtr); - } - *localIndexPtr = localIndex; - *simpleVarNamePtr = simpleVarName; - *isScalarPtr = (elName == NULL); + OP( TCLOO_SELF); + OP( POP); + OP( NS_CURRENT); return TCL_OK; } diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index f73beca..2c090ff 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -27,11 +27,6 @@ static void FreeJumptableInfo(ClientData clientData); static void PrintJumptableInfo(ClientData clientData, Tcl_Obj *appendObj, ByteCode *codePtr, unsigned int pcOffset); -static int PushVarName(Tcl_Interp *interp, - Tcl_Token *varTokenPtr, CompileEnv *envPtr, - int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, - int line, int *clNext); static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); @@ -69,53 +64,6 @@ static int IssueTryInstructions(Tcl_Interp *interp, int *optionVarIndices, Tcl_Token **handlerTokens); /* - * Macro that encapsulates an efficiency trick that avoids a function call for - * the simplest of compiles. The ANSI C "prototype" for this macro is: - * - * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, - * Tcl_Interp *interp, int word); - */ - -#define CompileWord(envPtr, tokenPtr, interp, word) \ - if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ - TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ - (tokenPtr)[1].size), (envPtr)); \ - } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ - TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ - (envPtr)); \ - } - -/* - * TIP #280: Remember the per-word line information of the current command. An - * index is used instead of a pointer as recursive compilation may reallocate, - * i.e. move, the array. This is also the reason to save the nuloc now, it may - * change during the course of the function. - * - * Macro to encapsulate the variable definition and setup. - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 - -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] - -#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ - PushVarName(i,v,e,f,l,s,sc, \ - mapPtr->loc[eclIndex].line[(word)], \ - mapPtr->loc[eclIndex].next[(word)]) - -/* - * Flags bits used by PushVarName. - */ - -#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ - -/* * The structures below define the AuxData types defined in this file. */ @@ -125,30 +73,6 @@ const AuxDataType tclJumptableInfoType = { FreeJumptableInfo, /* freeProc */ PrintJumptableInfo /* printProc */ }; - -/* - * Shorthand macros for instruction issuing. - */ - -#define OP(name) TclEmitOpcode(INST_##name, envPtr) -#define OP1(name,val) TclEmitInstInt1(INST_##name,(val),envPtr) -#define OP4(name,val) TclEmitInstInt4(INST_##name,(val),envPtr) -#define OP14(name,val1,val2) \ - TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) -#define OP44(name,val1,val2) \ - TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr) -#define BODY(token,index) \ - SetLineInformation((index));CompileBody(envPtr,(token),interp) -#define PUSH(str) \ - PushLiteral(envPtr,(str),strlen(str)) -#define JUMP(var,name) \ - (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name,0,envPtr) -#define FIXJUMP(var) \ - TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1) -#define LOAD(idx) \ - if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));} -#define STORE(idx) \ - if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} /* *---------------------------------------------------------------------- @@ -196,8 +120,8 @@ TclCompileSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * If we are doing an assignment, push the new value. @@ -205,7 +129,7 @@ TclCompileSetCmd( if (isAssignment) { valueTokenPtr = TokenAfter(varTokenPtr); - CompileWord(envPtr, valueTokenPtr, interp, 2); + PUSH_SUBST_WORD(valueTokenPtr, 2); } /* @@ -218,26 +142,18 @@ TclCompileSetCmd( TclEmitOpcode((isAssignment? INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr); - } else if (localIndex <= 255) { - TclEmitInstInt1((isAssignment? - INST_STORE_SCALAR1 : INST_LOAD_SCALAR1), - localIndex, envPtr); } else { TclEmitInstInt4((isAssignment? - INST_STORE_SCALAR4 : INST_LOAD_SCALAR4), + INST_STORE_SCALAR : INST_LOAD_SCALAR), localIndex, envPtr); } } else { if (localIndex < 0) { TclEmitOpcode((isAssignment? INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr); - } else if (localIndex <= 255) { - TclEmitInstInt1((isAssignment? - INST_STORE_ARRAY1 : INST_LOAD_ARRAY1), - localIndex, envPtr); } else { TclEmitInstInt4((isAssignment? - INST_STORE_ARRAY4 : INST_LOAD_ARRAY4), + INST_STORE_ARRAY : INST_LOAD_ARRAY), localIndex, envPtr); } } @@ -292,10 +208,10 @@ TclCompileStringCmpCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode(INST_STR_CMP, envPtr); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( STR_CMP); return TCL_OK; } @@ -324,10 +240,10 @@ TclCompileStringEqualCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode(INST_STR_EQ, envPtr); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( STR_EQ); return TCL_OK; } @@ -356,10 +272,10 @@ TclCompileStringFirstCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - OP(STR_FIND); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( STR_FIND); return TCL_OK; } @@ -388,10 +304,10 @@ TclCompileStringLastCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - OP(STR_FIND_LAST); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( STR_FIND_LAST); return TCL_OK; } @@ -416,10 +332,10 @@ TclCompileStringIndexCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - TclEmitOpcode(INST_STR_INDEX, envPtr); + PUSH_SUBST_WORD(tokenPtr, 2); + OP( STR_INDEX); return TCL_OK; } @@ -486,8 +402,7 @@ TclCompileStringMatchCmd( } PushLiteral(envPtr, str, length); } else { - SetLineInformation(i+1+nocase); - CompileTokens(envPtr, tokenPtr, interp); + PUSH_SUBST_WORD(tokenPtr, i+1+nocase); } tokenPtr = TokenAfter(tokenPtr); } @@ -497,9 +412,9 @@ TclCompileStringMatchCmd( */ if (exactMatch) { - TclEmitOpcode(INST_STR_EQ, envPtr); + OP( STR_EQ); } else { - TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr); + OP1( STR_MATCH, nocase); } return TCL_OK; } @@ -530,15 +445,13 @@ TclCompileStringLenCmd( * byte) length. */ - char buf[TCL_INTEGER_SPACE]; - int len = Tcl_GetCharLength(objPtr); + Tcl_Obj *lenObj = Tcl_NewIntObj(Tcl_GetCharLength(objPtr)); - len = sprintf(buf, "%d", len); - PushLiteral(envPtr, buf, len); + PUSH_OBJ(lenObj); + TclDecrRefCount(lenObj); } else { - SetLineInformation(1); - CompileTokens(envPtr, tokenPtr, interp); - TclEmitOpcode(INST_STR_LEN, envPtr); + PUSH_SUBST_WORD(tokenPtr, 1); + OP(STR_LEN); } TclDecrRefCount(objPtr); return TCL_OK; @@ -556,7 +469,6 @@ TclCompileStringMapCmd( DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; - char *bytes; int len; /* @@ -593,15 +505,14 @@ TclCompileStringMapCmd( * correct semantics for mapping. */ - bytes = Tcl_GetStringFromObj(objv[0], &len); + (void) Tcl_GetStringFromObj(objv[0], &len); if (len == 0) { - CompileWord(envPtr, stringTokenPtr, interp, 2); + PUSH_SUBST_WORD(stringTokenPtr, 2); } else { - PushLiteral(envPtr, bytes, len); - bytes = Tcl_GetStringFromObj(objv[1], &len); - PushLiteral(envPtr, bytes, len); - CompileWord(envPtr, stringTokenPtr, interp, 2); - OP(STR_MAP); + PUSH_OBJ(objv[0]); + PUSH_OBJ(objv[1]); + PUSH_SUBST_WORD(stringTokenPtr, 2); + OP( STR_MAP); } Tcl_DecrRefCount(mapObj); return TCL_OK; @@ -680,7 +591,7 @@ TclCompileStringRangeCmd( * Push the operand onto the stack and then the substring operation. */ - CompileWord(envPtr, stringTokenPtr, interp, 1); + PUSH_SUBST_WORD( stringTokenPtr, 1); OP44( STR_RANGE_IMM, idx1, idx2); return TCL_OK; @@ -689,9 +600,9 @@ TclCompileStringRangeCmd( */ nonConstantIndices: - CompileWord(envPtr, stringTokenPtr, interp, 1); - CompileWord(envPtr, fromTokenPtr, interp, 2); - CompileWord(envPtr, toTokenPtr, interp, 3); + PUSH_SUBST_WORD( stringTokenPtr, 1); + PUSH_SUBST_WORD( fromTokenPtr, 2); + PUSH_SUBST_WORD( toTokenPtr, 3); OP( STR_RANGE); return TCL_OK; } @@ -793,7 +704,7 @@ TclSubstCompile( CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; - int breakOffset = 0, count = 0, bline = line; + int breakOffset = -1, count = 0, bline = line; Tcl_Parse parse; Tcl_InterpState state = NULL; @@ -802,23 +713,22 @@ TclSubstCompile( /* * Tricky point! If the first token does not result in a *guaranteed* push * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it - * is possible to get to an INST_CONCAT1 or INST_DONE without enough + * is possible to get to an INST_CONCAT or INST_DONE without enough * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for * identifying a script that could trigger this case. */ tokenPtr = parse.tokenPtr; if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) { - PushLiteral(envPtr, "", 0); + PUSH(""); count++; } for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { - int length, literal, catchRange, breakJump; + int length, literal, catchRange; char buf[TCL_UTF_MAX]; - JumpFixup startFixup, okFixup, returnFixup, breakFixup; - JumpFixup continueFixup, otherFixup, endFixup; + int gotOK, gotReturn, gotBreak, gotContinue, gotOther, toEnd; switch (tokenPtr->type) { case TCL_TOKEN_TEXT: @@ -867,32 +777,30 @@ TclSubstCompile( } while (count > 255) { - OP1( CONCAT1, 255); + OP1( CONCAT, 255); count -= 254; } if (count > 1) { - OP1( CONCAT1, count); + OP1( CONCAT, count); count = 1; } - if (breakOffset == 0) { + if (breakOffset == -1) { + int start; + /* Jump to the start (jump over the jump to end) */ - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup); + JUMP(start, JUMP); /* Jump to the end (all BREAKs land here) */ - breakOffset = CurrentOffset(envPtr); - TclEmitInstInt4(INST_JUMP4, 0, envPtr); + JUMP(breakOffset, JUMP); /* Start */ - if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d", - (int) (CurrentOffset(envPtr) - startFixup.codeOffset)); - } + FIXJUMP(start); } envPtr->line = bline; catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - OP4( BEGIN_CATCH4, catchRange); + OP4( BEGIN_CATCH, catchRange); ExceptionRangeStarts(envPtr, catchRange); switch (tokenPtr->type) { @@ -913,73 +821,55 @@ TclSubstCompile( ExceptionRangeEnds(envPtr, catchRange); /* Substitution produced TCL_OK */ - OP( END_CATCH); - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup); + OP( END_CATCH); + JUMP(gotOK, JUMP); /* Exceptional return codes processed here */ ExceptionRangeTarget(envPtr, catchRange, catchOffset); - OP( PUSH_RETURN_OPTIONS); - OP( PUSH_RESULT); - OP( PUSH_RETURN_CODE); - OP( END_CATCH); - OP( RETURN_CODE_BRANCH); + OP( PUSH_RETURN_OPTIONS); + OP( PUSH_RESULT); + OP( PUSH_RETURN_CODE); + OP( END_CATCH); + OP( RETURN_CODE_BRANCH); /* ERROR -> reraise it */ - OP( RETURN_STK); - OP( NOP); + OP( RETURN_STK); + OP( NOP); + OP( NOP); + OP( NOP); + OP( NOP); /* RETURN */ - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup); - + JUMP(gotReturn, JUMP); /* BREAK */ - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &breakFixup); - + JUMP(gotBreak, JUMP); /* CONTINUE */ - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &continueFixup); - + JUMP(gotContinue, JUMP); /* OTHER */ - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup); + JUMP(gotOther, JUMP); /* BREAK destination */ - if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d", - (int) (CurrentOffset(envPtr) - breakFixup.codeOffset)); - } - OP( POP); - OP( POP); - - breakJump = CurrentOffset(envPtr) - breakOffset; - if (breakJump > 127) { - OP4(JUMP4, -breakJump); - } else { - OP1(JUMP1, -breakJump); - } + FIXJUMP(gotBreak); + OP( POP); + OP( POP); + BACKJUMP(breakOffset, JUMP); /* CONTINUE destination */ - if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d", - (int) (CurrentOffset(envPtr) - continueFixup.codeOffset)); - } - OP( POP); - OP( POP); - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup); + FIXJUMP(gotContinue); + OP( POP); + OP( POP); + JUMP(toEnd, JUMP); /* RETURN + other destination */ - if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d", - (int) (CurrentOffset(envPtr) - returnFixup.codeOffset)); - } - if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d", - (int) (CurrentOffset(envPtr) - otherFixup.codeOffset)); - } + FIXJUMP(gotReturn); + FIXJUMP(gotOther); /* * Pull the result to top of stack, discard options dict. */ - OP4( REVERSE, 2); - OP( POP); + OP( EXCH); + OP( POP); /* * We've emitted several POP instructions, and the automatic @@ -993,29 +883,23 @@ TclSubstCompile( TclAdjustStackDepth(5, envPtr); /* OK destination */ - if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d", - (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); - } + FIXJUMP(gotOK); if (count > 1) { - OP1(CONCAT1, count); + OP1( CONCAT, count); count = 1; } /* CONTINUE jump to here */ - if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) { - Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d", - (int) (CurrentOffset(envPtr) - endFixup.codeOffset)); - } + FIXJUMP(toEnd); bline = envPtr->line; } while (count > 255) { - OP1( CONCAT1, 255); + OP1( CONCAT, 255); count -= 254; } if (count > 1) { - OP1( CONCAT1, count); + OP1( CONCAT, count); } Tcl_FreeParse(&parse); @@ -1027,10 +911,7 @@ TclSubstCompile( } /* Final target of the multi-jump from all BREAKs */ - if (breakOffset > 0) { - TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset, - envPtr->codeStart + breakOffset); - } + FIXJUMP(breakOffset); } /* @@ -1422,8 +1303,7 @@ IssueSwitchChainedTests( * First, we push the value we're matching against on the stack. */ - SetLineInformation(valueIndex); - CompileTokens(envPtr, valueTokenPtr, interp); + PUSH_SUBST_WORD(valueTokenPtr, valueIndex); /* * Generate a test for each arm. @@ -1453,7 +1333,7 @@ IssueSwitchChainedTests( break; case Switch_Glob: TclCompileTokens(interp, bodyToken[i], 1, envPtr); - OP4( OVER, 1); + OP( UNDER); OP1( STR_MATCH, noCase); break; case Switch_Regexp: @@ -1472,7 +1352,7 @@ IssueSwitchChainedTests( * when the RE == "". */ - PushLiteral(envPtr, "1", 1); + PUSH("1"); break; } @@ -1484,8 +1364,7 @@ IssueSwitchChainedTests( if (TclReToGlob(NULL, bodyToken[i]->start, bodyToken[i]->size, &ds, &exact) == TCL_OK) { simple = 1; - PushLiteral(envPtr, Tcl_DStringValue(&ds), - Tcl_DStringLength(&ds)); + PUSH_DSTRING(&ds); Tcl_DStringFree(&ds); } } @@ -1493,7 +1372,6 @@ IssueSwitchChainedTests( TclCompileTokens(interp, bodyToken[i], 1, envPtr); } - OP4( OVER, 1); if (!simple) { /* * Pass correct RE compile flags. We use only Int1 @@ -1505,10 +1383,12 @@ IssueSwitchChainedTests( int cflags = TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0); + OP( UNDER); OP1(REGEXP, cflags); } else if (exact && !noCase) { OP( STR_EQ); } else { + OP( UNDER); OP1(STR_MATCH, noCase); } break; @@ -1563,7 +1443,7 @@ IssueSwitchChainedTests( int j; for (j=0 ; j<contFixCount ; j++) { - fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr); + LABEL(fixupTargetArray[contFixIndex+j]); } contFixIndex = -1; } @@ -1584,7 +1464,7 @@ IssueSwitchChainedTests( TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &fixupArray[fixupCount]); fixupCount++; - fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr); + LABEL(fixupTargetArray[nextArmFixupIndex]); } } @@ -1597,7 +1477,7 @@ IssueSwitchChainedTests( if (!foundDefault) { OP( POP); - PushLiteral(envPtr, "", 0); + PUSH( ""); } /* @@ -1607,7 +1487,7 @@ IssueSwitchChainedTests( for (i=0 ; i<fixupCount ; i++) { if (fixupTargetArray[i] == 0) { - fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart; + LABEL(fixupTargetArray[i]); } } @@ -1678,8 +1558,7 @@ IssueSwitchJumpTable( * First, we push the value we're matching against on the stack. */ - SetLineInformation(valueIndex); - CompileTokens(envPtr, valueTokenPtr, interp); + PUSH_SUBST_WORD(valueTokenPtr, valueIndex); /* * Compile the switch by using a jump table, which is basically a @@ -1707,10 +1586,9 @@ IssueSwitchJumpTable( * because that makes the code much easier to debug! */ - jumpLocation = CurrentOffset(envPtr); + LABEL(jumpLocation); OP4( JUMP_TABLE, infoIndex); - jumpToDefault = CurrentOffset(envPtr); - OP4( JUMP4, 0); + JUMP(jumpToDefault, JUMP); for (i=0 ; i<numBodyTokens ; i+=2) { /* @@ -1749,8 +1627,7 @@ IssueSwitchJumpTable( foundDefault = 1; isNew = 1; - TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault, - envPtr->codeStart+jumpToDefault+1); + FIXJUMP(jumpToDefault); } /* @@ -1794,15 +1671,7 @@ IssueSwitchJumpTable( */ if (i+2 < numBodyTokens || !foundDefault) { - finalFixups[numRealBodies++] = CurrentOffset(envPtr); - - /* - * Easier by far to issue this jump as a fixed-width jump, since - * otherwise we'd need to do a lot more (and more awkward) - * rewriting when we fixed this all up. - */ - - OP4( JUMP4, 0); + JUMP(finalFixups[numRealBodies++], JUMP); } } @@ -1814,9 +1683,8 @@ IssueSwitchJumpTable( if (!foundDefault) { envPtr->currStackDepth = savedStackDepth; - TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault, - envPtr->codeStart+jumpToDefault+1); - PushLiteral(envPtr, "", 0); + FIXJUMP(jumpToDefault); + PUSH(""); } /* @@ -1825,8 +1693,7 @@ IssueSwitchJumpTable( */ for (i=0 ; i<numRealBodies ; i++) { - TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i], - envPtr->codeStart+finalFixups[i]+1); + FIXJUMP(finalFixups[i]); } /* @@ -1948,7 +1815,7 @@ TclCompileTailcallCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; - if (parsePtr->numWords < 2 || parsePtr->numWords > 256 + if (parsePtr->numWords < 2 || parsePtr->numWords > 255 || envPtr->procPtr == NULL) { return TCL_ERROR; } @@ -1957,9 +1824,9 @@ TclCompileTailcallCmd( CompileWord(envPtr, tokenPtr, interp, 0); for (i=1 ; i<parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, i); + PUSH_SUBST_WORD(tokenPtr, i); } - TclEmitInstInt1( INST_TAILCALL, parsePtr->numWords, envPtr); + OP1( TAILCALL, parsePtr->numWords); return TCL_OK; } @@ -2006,7 +1873,6 @@ TclCompileThrowCmd( Tcl_IncrRefCount(objPtr); if (TclWordKnownAtCompileTime(codeToken, objPtr)) { Tcl_Obj *errPtr, *dictPtr; - const char *string; int len; /* @@ -2020,7 +1886,7 @@ TclCompileThrowCmd( * "ignored" value prepared as an argument. */ - CompileWord(envPtr, msgToken, interp, 2); + PUSH_SUBST_WORD(msgToken, 2); TclCompileSyntaxError(interp, envPtr); Tcl_DecrRefCount(objPtr); envPtr->currStackDepth = savedStackDepth + 1; @@ -2032,20 +1898,20 @@ TclCompileThrowCmd( * "ignored" value prepared as an argument. */ - CompileWord(envPtr, msgToken, interp, 2); + PUSH_SUBST_WORD(msgToken, 2); goto issueErrorForEmptyCode; } TclNewLiteralStringObj(errPtr, "-errorcode"); TclNewObj(dictPtr); Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr); - Tcl_IncrRefCount(dictPtr); - string = Tcl_GetStringFromObj(dictPtr, &len); - CompileWord(envPtr, msgToken, interp, 2); - PushLiteral(envPtr, string, len); + PUSH_SUBST_WORD(msgToken, 2); + PUSH_OBJ(dictPtr); TclDecrRefCount(dictPtr); OP44( RETURN_IMM, 1, 0); envPtr->currStackDepth = savedStackDepth + 1; } else { + int badThrowCode; + /* * When the code token is not known at compilation time, we need to do * a little bit more work. The main tricky bit here is that the error @@ -2053,15 +1919,16 @@ TclCompileThrowCmd( * instructions to enforce that condition. */ - CompileWord(envPtr, codeToken, interp, 1); + PUSH_SUBST_WORD(codeToken, 1); PUSH( "-errorcode"); - CompileWord(envPtr, msgToken, interp, 2); + PUSH_SUBST_WORD(msgToken, 2); OP4( REVERSE, 3); OP( DUP); OP( LIST_LENGTH); - OP1( JUMP_FALSE1, 16); + JUMP(badThrowCode, JUMP_FALSE); OP4( LIST, 2); OP44( RETURN_IMM, 1, 0); + FIXJUMP(badThrowCode); /* * Generate an error for being an empty list. Can't leverage anything @@ -2342,12 +2209,12 @@ IssueTryInstructions( DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int savedStackDepth = envPtr->currStackDepth; - int i, j, len, forwardsNeedFixing = 0; + int i, j, len, forwardsNeedFixing = 0, pushBodyOpts; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; - resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + resultVar = NewUnnamedLocal(envPtr); + optionsVar = NewUnnamedLocal(envPtr); if (resultVar < 0 || optionsVar < 0) { return TCL_ERROR; } @@ -2360,21 +2227,22 @@ IssueTryInstructions( */ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - OP4( BEGIN_CATCH4, range); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); BODY( bodyToken, 1); ExceptionRangeEnds(envPtr, range); PUSH( "0"); - OP4( REVERSE, 2); - OP1( JUMP1, 4); + OP( EXCH); + JUMP(pushBodyOpts, JUMP); ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_CODE); OP( PUSH_RESULT); + FIXJUMP(pushBodyOpts); OP( PUSH_RETURN_OPTIONS); OP( END_CATCH); - STORE( optionsVar); + OP4( STORE_SCALAR, optionsVar); OP( POP); - STORE( resultVar); + OP4( STORE_SCALAR, resultVar); OP( POP); /* @@ -2392,7 +2260,7 @@ IssueTryInstructions( OP( DUP); PUSH( buf); OP( EQ); - JUMP(notCodeJumpSource, JUMP_FALSE4); + JUMP(notCodeJumpSource, JUMP_FALSE); if (matchClauses[i]) { Tcl_ListObjLength(NULL, matchClauses[i], &len); @@ -2400,14 +2268,15 @@ IssueTryInstructions( * Match the errorcode according to try/trap rules. */ - LOAD( optionsVar); + + OP4( LOAD_SCALAR, optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); PUSH( TclGetString(matchClauses[i])); OP( STR_EQ); - JUMP(notECJumpSource, JUMP_FALSE4); + JUMP(notECJumpSource, JUMP_FALSE); } else { notECJumpSource = -1; /* LINT */ } @@ -2420,18 +2289,18 @@ IssueTryInstructions( */ if (resultVars[i] >= 0) { - LOAD( resultVar); - STORE( resultVars[i]); + OP4( LOAD_SCALAR, resultVar); + OP4( STORE_SCALAR, resultVars[i]); OP( POP); if (optionVars[i] >= 0) { - LOAD( optionsVar); - STORE( optionVars[i]); + OP4( LOAD_SCALAR, optionsVar); + OP4( STORE_SCALAR, optionVars[i]); OP( POP); } } if (!handlerTokens[i]) { forwardsNeedFixing = 1; - JUMP(forwardsToFix[i], JUMP4); + JUMP(forwardsToFix[i], JUMP); } else { forwardsToFix[i] = -1; if (forwardsNeedFixing) { @@ -2448,7 +2317,7 @@ IssueTryInstructions( BODY( handlerTokens[i], 5+i*4); } - JUMP(addrsToFix[i], JUMP4); + JUMP(addrsToFix[i], JUMP); if (matchClauses[i]) { FIXJUMP(notECJumpSource); } @@ -2462,8 +2331,8 @@ IssueTryInstructions( */ OP( POP); - LOAD( optionsVar); - LOAD( resultVar); + OP4( LOAD_SCALAR, optionsVar); + OP4( LOAD_SCALAR, resultVar); OP( RETURN_STK); /* @@ -2497,10 +2366,11 @@ IssueTryFinallyInstructions( int savedStackDepth = envPtr->currStackDepth; int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; + int pushBodyOpts, saveResultForLater; char buf[TCL_INTEGER_SPACE]; - resultVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); - optionsVar = TclFindCompiledLocal(NULL, 0, 1, envPtr); + resultVar = NewUnnamedLocal(envPtr); + optionsVar = NewUnnamedLocal(envPtr); if (resultVar < 0 || optionsVar < 0) { return TCL_ERROR; } @@ -2511,22 +2381,23 @@ IssueTryFinallyInstructions( */ range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - OP4( BEGIN_CATCH4, range); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); envPtr->currStackDepth = savedStackDepth; BODY( bodyToken, 1); ExceptionRangeEnds(envPtr, range); PUSH( "0"); - OP4( REVERSE, 2); - OP1( JUMP1, 4); + OP( EXCH); + JUMP(pushBodyOpts, JUMP); ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_CODE); OP( PUSH_RESULT); + FIXJUMP(pushBodyOpts); OP( PUSH_RETURN_OPTIONS); OP( END_CATCH); - STORE( optionsVar); + OP4( STORE_SCALAR, optionsVar); OP( POP); - STORE( resultVar); + OP4( STORE_SCALAR, resultVar); OP( POP); envPtr->currStackDepth = savedStackDepth + 1; @@ -2547,7 +2418,7 @@ IssueTryFinallyInstructions( OP( DUP); PUSH( buf); OP( EQ); - JUMP(notCodeJumpSource, JUMP_FALSE4); + JUMP(notCodeJumpSource, JUMP_FALSE); if (matchClauses[i]) { Tcl_ListObjLength(NULL, matchClauses[i], &len); @@ -2555,14 +2426,14 @@ IssueTryFinallyInstructions( * Match the errorcode according to try/trap rules. */ - LOAD( optionsVar); + OP4( LOAD_SCALAR, optionsVar); PUSH( "-errorcode"); OP4( DICT_GET, 1); TclAdjustStackDepth(-1, envPtr); OP44( LIST_RANGE_IMM, 0, len-1); PUSH( TclGetString(matchClauses[i])); OP( STR_EQ); - JUMP(notECJumpSource, JUMP_FALSE4); + JUMP(notECJumpSource, JUMP_FALSE); } else { notECJumpSource = -1; /* LINT */ } @@ -2576,16 +2447,16 @@ IssueTryFinallyInstructions( if (resultVars[i] >= 0 || handlerTokens[i]) { range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE); - OP4( BEGIN_CATCH4, range); + OP4( BEGIN_CATCH, range); ExceptionRangeStarts(envPtr, range); } if (resultVars[i] >= 0) { - LOAD( resultVar); - STORE( resultVars[i]); + OP4( LOAD_SCALAR, resultVar); + OP4( STORE_SCALAR, resultVars[i]); OP( POP); if (optionVars[i] >= 0) { - LOAD( optionsVar); - STORE( optionVars[i]); + OP4( LOAD_SCALAR, optionsVar); + OP4( STORE_SCALAR, optionVars[i]); OP( POP); } @@ -2599,7 +2470,8 @@ IssueTryFinallyInstructions( ExceptionRangeEnds(envPtr, range); OP( END_CATCH); forwardsNeedFixing = 1; - JUMP(forwardsToFix[i], JUMP4); + JUMP(forwardsToFix[i], JUMP); + saveResultForLater = -1; goto finishTrapCatchHandling; } } else if (!handlerTokens[i]) { @@ -2609,7 +2481,7 @@ IssueTryFinallyInstructions( */ forwardsNeedFixing = 1; - JUMP(forwardsToFix[i], JUMP4); + JUMP(forwardsToFix[i], JUMP); goto endOfThisArm; } @@ -2621,22 +2493,19 @@ IssueTryFinallyInstructions( if (forwardsNeedFixing) { forwardsNeedFixing = 0; - OP1( JUMP1, 7); + OP4( JUMP, 10); for (j=0 ; j<i ; j++) { - if (forwardsToFix[j] == -1) { - continue; - } FIXJUMP(forwardsToFix[j]); forwardsToFix[j] = -1; } - OP4( BEGIN_CATCH4, range); + OP4( BEGIN_CATCH, range); } envPtr->currStackDepth = savedStackDepth; BODY( handlerTokens[i], 5+i*4); ExceptionRangeEnds(envPtr, range); OP( PUSH_RETURN_OPTIONS); - OP4( REVERSE, 2); - OP1( JUMP1, 4); + OP( EXCH); + JUMP(saveResultForLater, JUMP); forwardsToFix[i] = -1; /* @@ -2650,15 +2519,16 @@ IssueTryFinallyInstructions( ExceptionRangeTarget(envPtr, range, catchOffset); OP( PUSH_RETURN_OPTIONS); OP( PUSH_RESULT); + FIXJUMP(saveResultForLater); OP( END_CATCH); - STORE( resultVar); + OP4( STORE_SCALAR, resultVar); OP( POP); - STORE( optionsVar); + OP4( STORE_SCALAR, optionsVar); OP( POP); endOfThisArm: if (i+1 < numHandlers) { - JUMP(addrsToFix[i], JUMP4); + JUMP(addrsToFix[i], JUMP); } if (matchClauses[i]) { FIXJUMP(notECJumpSource); @@ -2695,8 +2565,8 @@ IssueTryFinallyInstructions( envPtr->currStackDepth = savedStackDepth; BODY( finallyToken, 3 + 4*numHandlers); OP( POP); - LOAD( optionsVar); - LOAD( resultVar); + OP4( LOAD_SCALAR, optionsVar); + OP4( LOAD_SCALAR, resultVar); OP( RETURN_STK); envPtr->currStackDepth = savedStackDepth + 1; @@ -2771,8 +2641,8 @@ TclCompileUnsetCmd( * namespace qualifiers. */ - PushVarNameWord(interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar, 1); + PUSH_VAR( varTokenPtr, 1, + &localIndex, &simpleVarName, &isScalar); /* * Emit instructions to unset the variable. @@ -2796,7 +2666,7 @@ TclCompileUnsetCmd( varTokenPtr = TokenAfter(varTokenPtr); } - PushLiteral(envPtr, "", 0); + PUSH(""); return TCL_OK; } @@ -2915,7 +2785,7 @@ TclCompileWhileCmd( */ envPtr->atCmdStart = 0; - testCodeOffset = CurrentOffset(envPtr); + LABEL(testCodeOffset); } /* @@ -2935,30 +2805,19 @@ TclCompileWhileCmd( */ if (loopMayEnd) { - testCodeOffset = CurrentOffset(envPtr); + LABEL(testCodeOffset); jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { bodyCodeOffset += 3; testCodeOffset += 3; } envPtr->currStackDepth = savedStackDepth; - SetLineInformation(1); - TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + PUSH_EXPR_WORD(testTokenPtr, 1); envPtr->currStackDepth = savedStackDepth + 1; - jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; - if (jumpDist > 127) { - TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr); - } else { - TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr); - } + BACKJUMP(bodyCodeOffset, JUMP_TRUE); } else { - jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; - if (jumpDist > 127) { - TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr); - } else { - TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr); - } + BACKJUMP(bodyCodeOffset, JUMP); } /* @@ -2975,7 +2834,7 @@ TclCompileWhileCmd( pushResult: envPtr->currStackDepth = savedStackDepth; - PushLiteral(envPtr, "", 0); + PUSH(""); return TCL_OK; } @@ -3011,12 +2870,11 @@ TclCompileYieldCmd( } if (parsePtr->numWords == 1) { - PushLiteral(envPtr, "", 0); + PUSH(""); } else { DefineLineInformation; /* TIP #280 */ - Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, valueTokenPtr, interp, 1); + PUSH_SUBST_WORD(TokenAfter(parsePtr->tokenPtr), 1); } OP( YIELD); return TCL_OK; @@ -3025,246 +2883,6 @@ TclCompileYieldCmd( /* *---------------------------------------------------------------------- * - * PushVarName -- - * - * Procedure used in the compiling where pushing a variable name is - * necessary (append, lappend, set). - * - * Results: - * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer - * evaluation to runtime. - * - * Side effects: - * Instructions are added to envPtr to execute the "set" command at - * runtime. - * - *---------------------------------------------------------------------- - */ - -static int -PushVarName( - Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Token *varTokenPtr, /* Points to a variable token. */ - CompileEnv *envPtr, /* Holds resulting instructions. */ - int flags, /* TCL_NO_LARGE_INDEX. */ - int *localIndexPtr, /* Must not be NULL. */ - int *simpleVarNamePtr, /* Must not be NULL. */ - int *isScalarPtr, /* Must not be NULL. */ - int line, /* Line the token starts on. */ - int *clNext) /* Reference to offset of next hidden cont. - * line. */ -{ - register const char *p; - const char *name, *elName; - register int i, n; - Tcl_Token *elemTokenPtr = NULL; - int nameChars, elNameChars, simpleVarName, localIndex; - int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; - - /* - * Decide if we can use a frame slot for the var/array name or if we need - * to emit code to compute and push the name at runtime. We use a frame - * slot (entry in the array of local vars) if we are compiling a procedure - * body and if the name is simple text that does not include namespace - * qualifiers. - */ - - simpleVarName = 0; - name = elName = NULL; - nameChars = elNameChars = 0; - localIndex = -1; - - /* - * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether - * curly braces surround the variable name. This really matters for array - * elements to handle things like - * set {x($foo)} 5 - * which raises an undefined var error if we are not careful here. - */ - - if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && - (varTokenPtr->start[0] != '{')) { - /* - * A simple variable name. Divide it up into "name" and "elName" - * strings. If it is not a local variable, look it up at runtime. - */ - - simpleVarName = 1; - - name = varTokenPtr[1].start; - nameChars = varTokenPtr[1].size; - if (name[nameChars-1] == ')') { - /* - * last char is ')' => potential array reference. - */ - - for (i=0,p=name ; i<nameChars ; i++,p++) { - if (*p == '(') { - elName = p + 1; - elNameChars = nameChars - i - 2; - nameChars = i; - break; - } - } - - if ((elName != NULL) && elNameChars) { - /* - * An array element, the element name is a simple string: - * assemble the corresponding token. - */ - - elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = elNameChars; - elemTokenPtr->numComponents = 0; - elemTokenCount = 1; - } - } - } else if (((n = varTokenPtr->numComponents) > 1) - && (varTokenPtr[1].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].type == TCL_TOKEN_TEXT) - && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { - /* - * Check for parentheses inside first token. - */ - - simpleVarName = 0; - for (i = 0, p = varTokenPtr[1].start; - i < varTokenPtr[1].size; i++, p++) { - if (*p == '(') { - simpleVarName = 1; - break; - } - } - if (simpleVarName) { - int remainingChars; - - /* - * Check the last token: if it is just ')', do not count it. - * Otherwise, remove the ')' and flag so that it is restored at - * the end. - */ - - if (varTokenPtr[n].size == 1) { - n--; - } else { - varTokenPtr[n].size--; - removedParen = n; - } - - name = varTokenPtr[1].start; - nameChars = p - varTokenPtr[1].start; - elName = p + 1; - remainingChars = (varTokenPtr[2].start - p) - 1; - elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2; - - if (remainingChars) { - /* - * Make a first token with the extra characters in the first - * token. - */ - - elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); - allocedTokens = 1; - elemTokenPtr->type = TCL_TOKEN_TEXT; - elemTokenPtr->start = elName; - elemTokenPtr->size = remainingChars; - elemTokenPtr->numComponents = 0; - elemTokenCount = n; - - /* - * Copy the remaining tokens. - */ - - memcpy(elemTokenPtr+1, varTokenPtr+2, - (n-1) * sizeof(Tcl_Token)); - } else { - /* - * Use the already available tokens. - */ - - elemTokenPtr = &varTokenPtr[2]; - elemTokenCount = n - 1; - } - } - } - - if (simpleVarName) { - /* - * See whether name has any namespace separators (::'s). - */ - - int hasNsQualifiers = 0; - - for (i = 0, p = name; i < nameChars; i++, p++) { - if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) { - hasNsQualifiers = 1; - break; - } - } - - /* - * Look up the var name's index in the array of local vars in the proc - * frame. If retrieving the var's value and it doesn't already exist, - * push its name and look it up at runtime. - */ - - if (!hasNsQualifiers) { - localIndex = TclFindCompiledLocal(name, nameChars, - 1, envPtr); - if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { - /* - * We'll push the name. - */ - - localIndex = -1; - } - } - if (localIndex < 0) { - PushLiteral(envPtr, name, nameChars); - } - - /* - * Compile the element script, if any. - */ - - if (elName != NULL) { - if (elNameChars) { - envPtr->line = line; - envPtr->clNext = clNext; - TclCompileTokens(interp, elemTokenPtr, elemTokenCount, - envPtr); - } else { - PushLiteral(envPtr, "", 0); - } - } - } else { - /* - * The var name isn't simple: compile and push it. - */ - - envPtr->line = line; - envPtr->clNext = clNext; - CompileTokens(envPtr, varTokenPtr, interp); - } - - if (removedParen) { - varTokenPtr[removedParen].size++; - } - if (allocedTokens) { - TclStackFree(interp, elemTokenPtr); - } - *localIndexPtr = localIndex; - *simpleVarNamePtr = simpleVarName; - *isScalarPtr = (elName == NULL); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * CompileUnaryOpCmd -- * * Utility routine to compile the unary operator commands. @@ -3294,7 +2912,7 @@ CompileUnaryOpCmd( return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); TclEmitOpcode(instruction, envPtr); return TCL_OK; } @@ -3335,10 +2953,10 @@ CompileAssociativeBinaryOpCmd( for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, words); + PUSH_SUBST_WORD(tokenPtr, words); } if (parsePtr->numWords <= 2) { - PushLiteral(envPtr, identity, -1); + PUSH(identity); words++; } if (words > 3) { @@ -3417,12 +3035,12 @@ CompileComparisonOpCmd( DefineLineInformation; /* TIP #280 */ if (parsePtr->numWords < 3) { - PushLiteral(envPtr, "1", 1); + PUSH("1"); } else if (parsePtr->numWords == 3) { tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD(tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); + PUSH_SUBST_WORD(tokenPtr, 2); TclEmitOpcode(instruction, envPtr); } else if (envPtr->procPtr == NULL) { /* @@ -3431,26 +3049,26 @@ CompileComparisonOpCmd( return TCL_ERROR; } else { - int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr); + int tmpIndex = NewUnnamedLocal(envPtr); int words; tokenPtr = TokenAfter(parsePtr->tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 1); + PUSH_SUBST_WORD( tokenPtr, 1); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, 2); - STORE(tmpIndex); + PUSH_SUBST_WORD( tokenPtr, 2); + OP4( STORE_SCALAR, tmpIndex); TclEmitOpcode(instruction, envPtr); for (words=3 ; words<parsePtr->numWords ;) { - LOAD(tmpIndex); + OP4( LOAD_SCALAR, tmpIndex); tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, words); + PUSH_SUBST_WORD( tokenPtr, words); if (++words < parsePtr->numWords) { - STORE(tmpIndex); + OP4( STORE_SCALAR, tmpIndex); } TclEmitOpcode(instruction, envPtr); } for (; words>3 ; words--) { - OP( BITAND); + OP( BITAND); } /* @@ -3458,7 +3076,7 @@ CompileComparisonOpCmd( * might be expensive elsewhere. */ - OP14( UNSET_SCALAR, 0, tmpIndex); + OP14( UNSET_SCALAR, 0, tmpIndex); } return TCL_OK; } @@ -3585,14 +3203,14 @@ TclCompilePowOpCmd( for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, words); + PUSH_SUBST_WORD(tokenPtr, words); } if (parsePtr->numWords <= 2) { - PushLiteral(envPtr, "1", 1); + PUSH("1"); words++; } while (--words > 1) { - TclEmitOpcode(INST_EXPON, envPtr); + OP( EXPON); } return TCL_OK; } @@ -3762,14 +3380,14 @@ TclCompileMinusOpCmd( } for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, words); + PUSH_SUBST_WORD(tokenPtr, words); } if (words == 2) { - TclEmitOpcode(INST_UMINUS, envPtr); + OP( UMINUS); return TCL_OK; } if (words == 3) { - TclEmitOpcode(INST_SUB, envPtr); + OP( SUB); return TCL_OK; } @@ -3778,10 +3396,10 @@ TclCompileMinusOpCmd( * calcuations, including roundoff errors. */ - TclEmitInstInt4(INST_REVERSE, words-1, envPtr); + OP4( REVERSE, words-1); while (--words > 1) { - TclEmitInstInt4(INST_REVERSE, 2, envPtr); - TclEmitOpcode(INST_SUB, envPtr); + OP( EXCH); + OP( SUB); } return TCL_OK; } @@ -3806,14 +3424,14 @@ TclCompileDivOpCmd( return TCL_ERROR; } if (parsePtr->numWords == 2) { - PushLiteral(envPtr, "1.0", 3); + PUSH("1.0"); } for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); - CompileWord(envPtr, tokenPtr, interp, words); + PUSH_SUBST_WORD(tokenPtr, words); } if (words <= 3) { - TclEmitOpcode(INST_DIV, envPtr); + OP( DIV); return TCL_OK; } @@ -3822,10 +3440,10 @@ TclCompileDivOpCmd( * calcuations, including roundoff errors. */ - TclEmitInstInt4(INST_REVERSE, words-1, envPtr); + OP4( REVERSE, words-1); while (--words > 1) { - TclEmitInstInt4(INST_REVERSE, 2, envPtr); - TclEmitOpcode(INST_DIV, envPtr); + OP( EXCH); + OP( DIV); } return TCL_OK; } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 890d518..0218882 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2353,11 +2353,7 @@ CompileExprTree( * command with the correct number of arguments. */ - if (numWords < 255) { - TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); - } else { - TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); - } + TclEmitInstInt4(INST_INVOKE_STK, numWords, envPtr); /* * Restore any saved numWords value. @@ -2397,16 +2393,14 @@ CompileExprTree( TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->next->jump); - TclEmitPush(TclRegisterNewLiteral(envPtr, - (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr); + PUSH((nodePtr->lexeme == AND) ? "1" : "0"); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpPtr->next->next->jump); TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127); if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { jumpPtr->next->next->jump.codeOffset += 3; } - TclEmitPush(TclRegisterNewLiteral(envPtr, - (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); + PUSH((nodePtr->lexeme == AND) ? "0" : "1"); TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump, 127); convert = 0; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 45a74d7..86de4bc 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -54,69 +54,53 @@ InstructionDesc const tclInstructionTable[] = { /* Name Bytes stackEffect #Opnds Operand types */ {"done", 1, -1, 0, {OPERAND_NONE}}, /* Finish ByteCode execution and return stktop (top stack item) */ - {"push1", 2, +1, 1, {OPERAND_UINT1}}, - /* Push object at ByteCode objArray[op1] */ - {"push4", 5, +1, 1, {OPERAND_UINT4}}, + {"push", 5, +1, 1, {OPERAND_UINT4}}, /* Push object at ByteCode objArray[op4] */ {"pop", 1, -1, 0, {OPERAND_NONE}}, /* Pop the topmost stack object */ {"dup", 1, +1, 0, {OPERAND_NONE}}, /* Duplicate the topmost stack object and push the result */ - {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}}, + {"concat", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Concatenate the top op1 items and push result */ - {"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}}, - /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */ - {"invokeStk4", 5, INT_MIN, 1, {OPERAND_UINT4}}, + {"invokeStk", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */ {"evalStk", 1, 0, 0, {OPERAND_NONE}}, /* Evaluate command in stktop using Tcl_EvalObj. */ {"exprStk", 1, 0, 0, {OPERAND_NONE}}, /* Execute expression in stktop using Tcl_ExprStringObj. */ - {"loadScalar1", 2, 1, 1, {OPERAND_LVT1}}, - /* Load scalar variable at index op1 <= 255 in call frame */ - {"loadScalar4", 5, 1, 1, {OPERAND_LVT4}}, - /* Load scalar variable at index op1 >= 256 in call frame */ + {"loadScalar", 5, 1, 1, {OPERAND_LVT4}}, + /* Load scalar variable at index op1 in call frame */ {"loadScalarStk", 1, 0, 0, {OPERAND_NONE}}, /* Load scalar variable; scalar's name is stktop */ - {"loadArray1", 2, 0, 1, {OPERAND_LVT1}}, - /* Load array element; array at slot op1<=255, element is stktop */ - {"loadArray4", 5, 0, 1, {OPERAND_LVT4}}, + {"loadArray", 5, 0, 1, {OPERAND_LVT4}}, /* Load array element; array at slot op1 > 255, element is stktop */ {"loadArrayStk", 1, -1, 0, {OPERAND_NONE}}, /* Load array element; element is stktop, array name is stknext */ {"loadStk", 1, 0, 0, {OPERAND_NONE}}, /* Load general variable; unparsed variable name is stktop */ - {"storeScalar1", 2, 0, 1, {OPERAND_LVT1}}, - /* Store scalar variable at op1<=255 in frame; value is stktop */ - {"storeScalar4", 5, 0, 1, {OPERAND_LVT4}}, - /* Store scalar variable at op1 > 255 in frame; value is stktop */ + {"storeScalar", 5, 0, 1, {OPERAND_LVT4}}, + /* Store scalar variable at op1 in frame; value is stktop */ {"storeScalarStk", 1, -1, 0, {OPERAND_NONE}}, /* Store scalar; value is stktop, scalar name is stknext */ - {"storeArray1", 2, -1, 1, {OPERAND_LVT1}}, - /* Store array element; array at op1<=255, value is top then elem */ - {"storeArray4", 5, -1, 1, {OPERAND_LVT4}}, + {"storeArray", 5, -1, 1, {OPERAND_LVT4}}, /* Store array element; array at op1>=256, value is top then elem */ {"storeArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Store array element; value is stktop, then elem, array names */ {"storeStk", 1, -1, 0, {OPERAND_NONE}}, /* Store general variable; value is stktop, then unparsed name */ - {"incrScalar1", 2, 0, 1, {OPERAND_LVT1}}, - /* Incr scalar at index op1<=255 in frame; incr amount is stktop */ - {"incrScalarStk", 1, -1, 0, {OPERAND_NONE}}, - /* Incr scalar; incr amount is stktop, scalar's name is stknext */ - {"incrArray1", 2, -1, 1, {OPERAND_LVT1}}, - /* Incr array elem; arr at slot op1<=255, amount is top then elem */ + {"incrScalar", 5, 0, 1, {OPERAND_LVT4}}, + /* Incr scalar at index op1 in frame; incr amount is stktop */ + {"incrArray", 5, -1, 1, {OPERAND_LVT4}}, + /* Incr array elem; arr at slot op1, amount is top then elem */ {"incrArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Incr array element; amount is top then elem then array names */ {"incrStk", 1, -1, 0, {OPERAND_NONE}}, /* Incr general variable; amount is stktop then unparsed var name */ - {"incrScalar1Imm", 3, +1, 2, {OPERAND_LVT1, OPERAND_INT1}}, + {"incrScalarImm", 6, +1, 2, {OPERAND_LVT4, OPERAND_INT1}}, /* Incr scalar at slot op1 <= 255; amount is 2nd operand byte */ - {"incrScalarStkImm", 2, 0, 1, {OPERAND_INT1}}, - /* Incr scalar; scalar name is stktop; incr amount is op1 */ - {"incrArray1Imm", 3, 0, 2, {OPERAND_LVT1, OPERAND_INT1}}, + {"incrArrayImm", 6, 0, 2, {OPERAND_LVT4, OPERAND_INT1}}, /* Incr array elem; array at slot op1 <= 255, elem is stktop, * amount is 2nd operand byte */ {"incrArrayStkImm", 2, -1, 1, {OPERAND_INT1}}, @@ -124,17 +108,11 @@ InstructionDesc const tclInstructionTable[] = { {"incrStkImm", 2, 0, 1, {OPERAND_INT1}}, /* Incr general variable; unparsed name is top, amount is op1 */ - {"jump1", 2, 0, 1, {OPERAND_INT1}}, - /* Jump relative to (pc + op1) */ - {"jump4", 5, 0, 1, {OPERAND_INT4}}, + {"jump", 5, 0, 1, {OPERAND_INT4}}, /* Jump relative to (pc + op4) */ - {"jumpTrue1", 2, -1, 1, {OPERAND_INT1}}, - /* Jump relative to (pc + op1) if stktop expr object is true */ - {"jumpTrue4", 5, -1, 1, {OPERAND_INT4}}, + {"jumpTrue", 5, -1, 1, {OPERAND_INT4}}, /* Jump relative to (pc + op4) if stktop expr object is true */ - {"jumpFalse1", 2, -1, 1, {OPERAND_INT1}}, - /* Jump relative to (pc + op1) if stktop expr object is false */ - {"jumpFalse4", 5, -1, 1, {OPERAND_INT4}}, + {"jumpFalse", 5, -1, 1, {OPERAND_INT4}}, /* Jump relative to (pc + op4) if stktop expr object is false */ {"lor", 1, -1, 0, {OPERAND_NONE}}, @@ -181,27 +159,28 @@ 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. */ + {"expon", 1, -1, 0, {OPERAND_NONE}}, + /* Binary exponentiation operator: push (stknext ** stktop) */ + {"listIn", 1, -1, 0, {OPERAND_NONE}}, + /* List containment: push [lsearch stktop stknext]>=0) */ + {"listNotIn", 1, -1, 0, {OPERAND_NONE}}, + /* List negated containment: push [lsearch stktop stknext]<0) */ - {"break", 1, 0, 0, {OPERAND_NONE}}, - /* Abort closest enclosing loop; if none, return TCL_BREAK code. */ - {"continue", 1, 0, 0, {OPERAND_NONE}}, - /* Skip to next iteration of closest enclosing loop; if none, return - * TCL_CONTINUE code. */ - - {"foreach_start4", 5, 0, 1, {OPERAND_AUX4}}, + {"foreach_start", 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}}, + {"foreach_step", 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}}, + {"break", 1, 0, 0, {OPERAND_NONE}}, + /* Abort closest enclosing loop; if none, return TCL_BREAK code. */ + {"continue", 1, 0, 0, {OPERAND_NONE}}, + /* Skip to next iteration of closest enclosing loop; if none, return + * TCL_CONTINUE code. */ + {"beginCatch", 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. */ {"endCatch", 1, 0, 0, {OPERAND_NONE}}, @@ -211,6 +190,19 @@ InstructionDesc const tclInstructionTable[] = { {"pushReturnCode", 1, +1, 0, {OPERAND_NONE}}, /* Push interpreter's return code (e.g. TCL_OK or TCL_ERROR) as a new * object onto the stack. */ + {"pushReturnOpts", 1, +1, 0, {OPERAND_NONE}}, + /* Push the interpreter's return option dictionary as an object on the + * stack. */ + {"returnStk", 1, -2, 0, {OPERAND_NONE}}, + /* Compiled [return]; options and result are on the stack, code and + * level are in the options. */ + {"returnImm", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, + /* Compiled [return], code, level are operands; options and result + * are on the stack. */ + {"returnCodeBranch", 1, -1, 0, {OPERAND_NONE}}, + /* Jump to next instruction based on the return code on top of stack + * ERROR: +1; RETURN: +6; BREAK: +11; CONTINUE: +16; + * Other non-OK: +21 */ {"streq", 1, -1, 0, {OPERAND_NONE}}, /* Str Equal: push (stknext eq stktop) */ @@ -232,25 +224,18 @@ InstructionDesc const tclInstructionTable[] = { {"listLength", 1, 0, 0, {OPERAND_NONE}}, /* List Len: push (listlength stktop) */ - {"appendScalar1", 2, 0, 1, {OPERAND_LVT1}}, - /* Append scalar variable at op1<=255 in frame; value is stktop */ - {"appendScalar4", 5, 0, 1, {OPERAND_LVT4}}, + {"appendScalar", 5, 0, 1, {OPERAND_LVT4}}, /* Append scalar variable at op1 > 255 in frame; value is stktop */ - {"appendArray1", 2, -1, 1, {OPERAND_LVT1}}, - /* Append array element; array at op1<=255, value is top then elem */ - {"appendArray4", 5, -1, 1, {OPERAND_LVT4}}, + {"appendArray", 5, -1, 1, {OPERAND_LVT4}}, /* Append array element; array at op1>=256, value is top then elem */ {"appendArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Append array element; value is stktop, then elem, array names */ {"appendStk", 1, -1, 0, {OPERAND_NONE}}, /* Append general variable; value is stktop, then unparsed name */ - {"lappendScalar1", 2, 0, 1, {OPERAND_LVT1}}, - /* Lappend scalar variable at op1<=255 in frame; value is stktop */ - {"lappendScalar4", 5, 0, 1, {OPERAND_LVT4}}, + + {"lappendScalar", 5, 0, 1, {OPERAND_LVT4}}, /* Lappend scalar variable at op1 > 255 in frame; value is stktop */ - {"lappendArray1", 2, -1, 1, {OPERAND_LVT1}}, - /* Lappend array element; array at op1<=255, value is top then elem */ - {"lappendArray4", 5, -1, 1, {OPERAND_LVT4}}, + {"lappendArray", 5, -1, 1, {OPERAND_LVT4}}, /* Lappend array element; array at op1>=256, value is top then elem */ {"lappendArrayStk", 1, -2, 0, {OPERAND_NONE}}, /* Lappend array element; value is stktop, then elem, array names */ @@ -261,8 +246,7 @@ InstructionDesc const tclInstructionTable[] = { /* Lindex with generalized args, operand is number of stacked objs * used: (operand-1) entries from stktop are the indices; then list to * process. */ - {"over", 5, +1, 1, {OPERAND_UINT4}}, - /* Duplicate the arg-th element from top of stack (TOS=0) */ + {"lsetList", 1, -2, 0, {OPERAND_NONE}}, /* Four-arg version of 'lset'. stktop is old value; next is new * element value, next is the index list; pushes new value */ @@ -272,12 +256,6 @@ InstructionDesc const tclInstructionTable[] = { * (operand-2) indices; pushes the new value. */ - {"returnImm", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, - /* Compiled [return], code, level are operands; options and result - * are on the stack. */ - {"expon", 1, -1, 0, {OPERAND_NONE}}, - /* Binary exponentiation operator: push (stknext ** stktop) */ - /* * NOTE: the stack effects of expandStkTop and invokeExpanded are wrong - * but it cannot be done right at compile time, the stack effect is only @@ -297,22 +275,11 @@ InstructionDesc const tclInstructionTable[] = { /* List Index: push (lindex stktop op4) */ {"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, /* List Range: push (lrange stktop op4 op4) */ + {"startCommand", 9, 0, 2, {OPERAND_INT4,OPERAND_UINT4}}, /* Start of bytecoded command: op is the length of the cmd's code, op2 * is number of commands here */ - {"listIn", 1, -1, 0, {OPERAND_NONE}}, - /* List containment: push [lsearch stktop stknext]>=0) */ - {"listNotIn", 1, -1, 0, {OPERAND_NONE}}, - /* List negated containment: push [lsearch stktop stknext]<0) */ - - {"pushReturnOpts", 1, +1, 0, {OPERAND_NONE}}, - /* Push the interpreter's return option dictionary as an object on the - * stack. */ - {"returnStk", 1, -2, 0, {OPERAND_NONE}}, - /* Compiled [return]; options and result are on the stack, code and - * level are in the options. */ - {"dictGet", 5, INT_MIN, 1, {OPERAND_UINT4}}, /* The top op4 words (min 1) are a key path into the dictionary just * below the keys on the stack, and all those values are replaced by @@ -348,9 +315,6 @@ 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 @@ -365,6 +329,30 @@ InstructionDesc const tclInstructionTable[] = { * argument. The list of keys (popped from the stack) must be the same * length as the list of variables. * Stack: ... keyList => ... */ + {"dictExpand", 1, -1, 0, {OPERAND_NONE}}, + /* Probe into a dict and extract it (or a subdict of it) into + * variables with matched names. Produces list of keys bound as + * result. Part of [dict with]. + * Stack: ... dict path => ... keyList */ + {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}}, + /* Map variable contents back into a dictionary in a variable. Part of + * [dict with]. + * Stack: ... dictVarName path keyList => ... */ + {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}}, + /* Map variable contents back into a dictionary in the local variable + * indicated by the LVT index. Part of [dict with]. + * Stack: ... path keyList => ... */ + {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}}, + /* The top op4 words (min 1) are a key path into the dictionary just + * below the keys on the stack, and all those values are replaced by a + * boolean indicating whether it is possible to read out a value from + * that key-path (like [dict exists]). + * Stack: ... dict key1 ... keyN => ... boolean */ + {"verifyDict", 1, -1, 0, {OPERAND_NONE}}, + /* Verifies that the word on the top of the stack is a dictionary, + * popping it if it is and throwing an error if it is not. + * Stack: ... value => ... */ + {"jumpTable", 5, -1, 1, {OPERAND_AUX4}}, /* Jump according to the jump-table (in AuxData as indicated by the * operand) and the argument popped from the list. Always executes the @@ -372,6 +360,7 @@ InstructionDesc const tclInstructionTable[] = { * Stack: ... value => ... * Note that the jump table contains offsets relative to the PC when * it points to this instruction; the code is relocatable. */ + {"upvar", 5, -1, 1, {OPERAND_LVT4}}, /* finds level and otherName in stack, links to local variable at * index op1. Leaves the level on stack. */ @@ -381,10 +370,15 @@ InstructionDesc const tclInstructionTable[] = { {"variable", 5, -1, 1, {OPERAND_LVT4}}, /* finds namespace and otherName in stack, links to local variable at * index op1. Leaves the namespace on stack. */ + + {"over", 5, +1, 1, {OPERAND_UINT4}}, + /* Duplicate the arg-th element from top of stack (TOS=0) */ {"syntax", 9, -1, 2, {OPERAND_INT4, OPERAND_UINT4}}, /* Compiled bytecodes to signal syntax error. */ {"reverse", 5, 0, 1, {OPERAND_UINT4}}, /* Reverse the order of the arg elements at the top of stack */ + {"nop", 1, 0, 0, {OPERAND_NONE}}, + /* Do nothing */ {"regexp", 2, -1, 1, {OPERAND_INT1}}, /* Regexp: push (regexp stknext stktop) opnd == nocase */ @@ -400,13 +394,6 @@ InstructionDesc const tclInstructionTable[] = { {"existStk", 1, 0, 0, {OPERAND_NONE}}, /* Test if general variable exists; unparsed variable name is stktop*/ - {"nop", 1, 0, 0, {OPERAND_NONE}}, - /* Do nothing */ - {"returnCodeBranch", 1, -1, 0, {OPERAND_NONE}}, - /* Jump to next instruction based on the return code on top of stack - * ERROR: +1; RETURN: +3; BREAK: +5; CONTINUE: +7; - * Other non-OK: +9 - */ {"unsetScalar", 6, 0, 2, {OPERAND_UINT1, OPERAND_LVT4}}, /* Make scalar variable at index op2 in call frame cease to exist; @@ -421,30 +408,6 @@ InstructionDesc const tclInstructionTable[] = { /* Make general variable cease to exist; unparsed variable name is * stktop; op1 is 1 for errors on problems, 0 otherwise */ - {"dictExpand", 1, -1, 0, {OPERAND_NONE}}, - /* Probe into a dict and extract it (or a subdict of it) into - * variables with matched names. Produces list of keys bound as - * result. Part of [dict with]. - * Stack: ... dict path => ... keyList */ - {"dictRecombineStk", 1, -3, 0, {OPERAND_NONE}}, - /* Map variable contents back into a dictionary in a variable. Part of - * [dict with]. - * Stack: ... dictVarName path keyList => ... */ - {"dictRecombineImm", 1, -2, 1, {OPERAND_LVT4}}, - /* Map variable contents back into a dictionary in the local variable - * indicated by the LVT index. Part of [dict with]. - * Stack: ... path keyList => ... */ - {"dictExists", 5, INT_MIN, 1, {OPERAND_UINT4}}, - /* The top op4 words (min 1) are a key path into the dictionary just - * below the keys on the stack, and all those values are replaced by a - * boolean indicating whether it is possible to read out a value from - * that key-path (like [dict exists]). - * Stack: ... dict key1 ... keyN => ... boolean */ - {"verifyDict", 1, -1, 0, {OPERAND_NONE}}, - /* Verifies that the word on the top of the stack is a dictionary, - * popping it if it is and throwing an error if it is not. - * Stack: ... value => ... */ - {"strmap", 1, -2, 0, {OPERAND_NONE}}, /* Simplified version of [string map] that only applies one change * string, and only case-sensitively. @@ -529,6 +492,12 @@ InstructionDesc const tclInstructionTable[] = { /* Forces the variable indexed by opnd to be an array. Does not touch * the stack. */ + {"exch", 1, 0, 0, {OPERAND_NONE}}, + /* Swap the two items on the top of the stack. + * Stack: ... a b => ... b a */ + {"under", 1, +1, 0, {OPERAND_NONE}}, + /* Duplicates the item under the top of the stack. + * Stack: ... a b => ... a b a */ {"invokeReplace", 6, INT_MIN, 2, {OPERAND_UINT4,OPERAND_UINT1}}, /* Invoke command named objv[0], replacing the first two words with * the word at the top of the stack; @@ -1579,6 +1548,8 @@ TclCompileScript( ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int *wlines, wlineat, cmdLine, *clNext; Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); + int generateStartCmds = Tcl_IsSafe(interp) || + Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME); Tcl_DStringInit(&ds); @@ -1775,6 +1746,7 @@ TclCompileScript( int code, savedNumCmds = envPtr->numCommands; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; + int savedExceptArrayNext = envPtr->exceptArrayNext; int update = 0; #ifdef TCL_COMPILE_DEBUG int startStackDepth = envPtr->currStackDepth; @@ -1798,24 +1770,29 @@ TclCompileScript( * command. */ - if (envPtr->atCmdStart) { - if (savedCodeNext != 0) { - /* - * Increase the number of commands being - * started at the current point. Note that - * this depends on the exact layout of the - * INST_START_CMD's operands, so be careful! - */ - - unsigned char *fixPtr = envPtr->codeNext - 4; - - TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1, - fixPtr); + if (generateStartCmds) { + if (envPtr->atCmdStart) { + if (savedCodeNext != 0) { + /* + * Increase the number of commands being + * started at the current point. Note that + * this depends on the exact layout of the + * INST_START_CMD's operands, so be + * careful! + */ + + unsigned char *fixPtr = + envPtr->codeNext - 4; + + TclStoreInt4AtPtr( + TclGetUInt4AtPtr(fixPtr) + 1, + fixPtr); + } + } else { + TclEmitInstInt4(INST_START_CMD, 0, envPtr); + TclEmitInt4(1, envPtr); + update = 1; } - } else { - TclEmitInstInt4(INST_START_CMD, 0, envPtr); - TclEmitInt4(1, envPtr); - update = 1; } code = cmdPtr->compileProc(interp, parsePtr, cmdPtr, @@ -1841,7 +1818,7 @@ TclCompileScript( parsePtr->tokenPtr->start, diff); } #endif - if (update) { + if (generateStartCmds && update) { /* * Fix the bytecode length. */ @@ -1856,7 +1833,8 @@ TclCompileScript( goto finishCommand; } - if (envPtr->atCmdStart && savedCodeNext != 0) { + if (generateStartCmds && envPtr->atCmdStart + && savedCodeNext != 0) { /* * Decrease the number of commands being started * at the current point. Note that this depends on @@ -1879,6 +1857,14 @@ TclCompileScript( envPtr->numCommands = savedNumCmds; envPtr->codeNext = envPtr->codeStart + savedCodeNext; + + /* + * Must also restore the number of exception ranges; + * cannot guarantee that none were issued before the + * failure. + */ + + envPtr->exceptArrayNext = savedExceptArrayNext; } /* @@ -1953,11 +1939,7 @@ TclCompileScript( &isnew); Tcl_SetHashValue(hePtr, INT2PTR(wlineat)); - if (wordIdx <= 255) { - TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); - } else { - TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); - } + TclEmitInstInt4(INST_INVOKE_STK, wordIdx, envPtr); } /* @@ -2094,19 +2076,15 @@ TclCompileVarSubst( if (tokenPtr->numComponents == 1) { if (localVar < 0) { TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr); - } else if (localVar <= 255) { - TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); } else { - TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr); + TclEmitInstInt4(INST_LOAD_SCALAR, localVar, envPtr); } } else { TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr); if (localVar < 0) { TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr); - } else if (localVar <= 255) { - TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr); } else { - TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr); + TclEmitInstInt4(INST_LOAD_ARRAY, localVar, envPtr); } } } @@ -2278,11 +2256,11 @@ TclCompileTokens( */ while (numObjsToConcat > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + TclEmitInstInt1(INST_CONCAT, 255, envPtr); numObjsToConcat -= 254; /* concat pushes 1 obj, the result */ } if (numObjsToConcat > 1) { - TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr); + TclEmitInstInt1(INST_CONCAT, numObjsToConcat, envPtr); } /* @@ -2413,11 +2391,11 @@ TclCompileExprWords( } concatItems = 2*numWords - 1; while (concatItems > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + TclEmitInstInt1(INST_CONCAT, 255, envPtr); concatItems -= 254; } if (concatItems > 1) { - TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr); + TclEmitInstInt1(INST_CONCAT, concatItems, envPtr); } TclEmitOpcode(INST_EXPR_STK, envPtr); } @@ -2425,6 +2403,246 @@ TclCompileExprWords( /* *---------------------------------------------------------------------- * + * PushVarName -- + * + * Procedure used in the compiling where pushing a variable name is + * necessary (append, lappend, set). + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "set" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclPushVarName( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Token *varTokenPtr, /* Points to a variable token. */ + CompileEnv *envPtr, /* Holds resulting instructions. */ + int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */ + int *localIndexPtr, /* Must not be NULL. */ + int *simpleVarNamePtr, /* Must not be NULL. */ + int *isScalarPtr, /* Must not be NULL. */ + int line, /* Line the token starts on. */ + int *clNext) /* Reference to offset of next hidden cont. + * line. */ +{ + register const char *p; + const char *name, *elName; + register int i, n; + Tcl_Token *elemTokenPtr = NULL; + int nameChars, elNameChars, simpleVarName, localIndex; + int elemTokenCount = 0, allocedTokens = 0, removedParen = 0; + + /* + * Decide if we can use a frame slot for the var/array name or if we need + * to emit code to compute and push the name at runtime. We use a frame + * slot (entry in the array of local vars) if we are compiling a procedure + * body and if the name is simple text that does not include namespace + * qualifiers. + */ + + simpleVarName = 0; + name = elName = NULL; + nameChars = elNameChars = 0; + localIndex = -1; + + /* + * Check not only that the type is TCL_TOKEN_SIMPLE_WORD, but whether + * curly braces surround the variable name. This really matters for array + * elements to handle things like + * set {x($foo)} 5 + * which raises an undefined var error if we are not careful here. + */ + + if ((varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) && + (varTokenPtr->start[0] != '{')) { + /* + * A simple variable name. Divide it up into "name" and "elName" + * strings. If it is not a local variable, look it up at runtime. + */ + + simpleVarName = 1; + + name = varTokenPtr[1].start; + nameChars = varTokenPtr[1].size; + if (name[nameChars-1] == ')') { + /* + * last char is ')' => potential array reference. + */ + + for (i=0,p=name ; i<nameChars ; i++,p++) { + if (*p == '(') { + elName = p + 1; + elNameChars = nameChars - i - 2; + nameChars = i; + break; + } + } + + if ((elName != NULL) && elNameChars) { + /* + * An array element, the element name is a simple string: + * assemble the corresponding token. + */ + + elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = elNameChars; + elemTokenPtr->numComponents = 0; + elemTokenCount = 1; + } + } + } else if (((n = varTokenPtr->numComponents) > 1) + && (varTokenPtr[1].type == TCL_TOKEN_TEXT) + && (varTokenPtr[n].type == TCL_TOKEN_TEXT) + && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) { + /* + * Check for parentheses inside first token. + */ + + simpleVarName = 0; + for (i = 0, p = varTokenPtr[1].start; + i < varTokenPtr[1].size; i++, p++) { + if (*p == '(') { + simpleVarName = 1; + break; + } + } + if (simpleVarName) { + int remainingChars; + + /* + * Check the last token: if it is just ')', do not count it. + * Otherwise, remove the ')' and flag so that it is restored at + * the end. + */ + + if (varTokenPtr[n].size == 1) { + n--; + } else { + varTokenPtr[n].size--; + removedParen = n; + } + + name = varTokenPtr[1].start; + nameChars = p - varTokenPtr[1].start; + elName = p + 1; + remainingChars = (varTokenPtr[2].start - p) - 1; + elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 2; + + if (remainingChars) { + /* + * Make a first token with the extra characters in the first + * token. + */ + + elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token)); + allocedTokens = 1; + elemTokenPtr->type = TCL_TOKEN_TEXT; + elemTokenPtr->start = elName; + elemTokenPtr->size = remainingChars; + elemTokenPtr->numComponents = 0; + elemTokenCount = n; + + /* + * Copy the remaining tokens. + */ + + memcpy(elemTokenPtr+1, varTokenPtr+2, + (n-1) * sizeof(Tcl_Token)); + } else { + /* + * Use the already available tokens. + */ + + elemTokenPtr = &varTokenPtr[2]; + elemTokenCount = n - 1; + } + } + } + + if (simpleVarName) { + /* + * See whether name has any namespace separators (::'s). + */ + + int hasNsQualifiers = 0; + + for (i = 0, p = name; i < nameChars; i++, p++) { + if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) { + hasNsQualifiers = 1; + break; + } + } + + /* + * Look up the var name's index in the array of local vars in the proc + * frame. If retrieving the var's value and it doesn't already exist, + * push its name and look it up at runtime. + */ + + if (!hasNsQualifiers) { + localIndex = TclFindCompiledLocal(name, nameChars, + 1, envPtr); + if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { + /* + * We'll push the name. + */ + + localIndex = -1; + } + } + if (localIndex < 0) { + PushLiteral(envPtr, name, nameChars); + } + + /* + * Compile the element script, if any. + */ + + if (elName != NULL && !(flags & TCL_NO_ELEMENT)) { + if (elNameChars) { + envPtr->line = line; + envPtr->clNext = clNext; + TclCompileTokens(interp, elemTokenPtr, elemTokenCount, + envPtr); + } else { + PUSH(""); + } + } + } else { + /* + * The var name isn't simple: compile and push it. + */ + + envPtr->line = line; + envPtr->clNext = clNext; + CompileTokens(envPtr, varTokenPtr, interp); + } + + if (removedParen) { + varTokenPtr[removedParen].size++; + } + if (allocedTokens) { + TclStackFree(interp, elemTokenPtr); + } + *localIndexPtr = localIndex; + *simpleVarNamePtr = simpleVarName; + *isScalarPtr = (elName == NULL); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileNoOp -- * * Function called to compile no-op's @@ -3338,13 +3556,13 @@ TclEmitForwardJump( switch (jumpType) { case TCL_UNCONDITIONAL_JUMP: - TclEmitInstInt1(INST_JUMP1, 0, envPtr); + TclEmitInstInt4(INST_JUMP, 0, envPtr); break; case TCL_TRUE_JUMP: - TclEmitInstInt1(INST_JUMP_TRUE1, 0, envPtr); + TclEmitInstInt4(INST_JUMP_TRUE, 0, envPtr); break; default: - TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); + TclEmitInstInt4(INST_JUMP_FALSE, 0, envPtr); break; } } @@ -3382,157 +3600,23 @@ TclFixupForwardJump( JumpFixup *jumpFixupPtr, /* Points to the JumpFixup structure that * describes the forward jump. */ int jumpDist, /* Jump distance to set in jump instr. */ - int distThreshold) /* Maximum distance before the two byte jump + int ignored) /* Maximum distance before the two byte jump * is grown to five bytes. */ { - unsigned char *jumpPc, *p; - int firstCmd, lastCmd, firstRange, lastRange, k; - unsigned numBytes; - - if (jumpDist <= distThreshold) { - jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; - switch (jumpFixupPtr->jumpType) { - case TCL_UNCONDITIONAL_JUMP: - TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc); - break; - case TCL_TRUE_JUMP: - TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc); - break; - default: - TclUpdateInstInt1AtPc(INST_JUMP_FALSE1, jumpDist, jumpPc); - break; - } - return 0; - } + unsigned char *jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; - /* - * We must grow the jump then move subsequent instructions down. Note that - * if we expand the space for generated instructions, code addresses might - * change; be careful about updating any of these addresses held in - * variables. - */ - - if ((envPtr->codeNext + 3) > envPtr->codeEnd) { - TclExpandCodeArray(envPtr); - } - jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; - numBytes = envPtr->codeNext-jumpPc-2; - p = jumpPc+2; - memmove(p+3, p, numBytes); - - envPtr->codeNext += 3; - jumpDist += 3; switch (jumpFixupPtr->jumpType) { case TCL_UNCONDITIONAL_JUMP: - TclUpdateInstInt4AtPc(INST_JUMP4, jumpDist, jumpPc); + TclUpdateInstInt4AtPc(INST_JUMP, jumpDist, jumpPc); break; case TCL_TRUE_JUMP: - TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDist, jumpPc); + TclUpdateInstInt4AtPc(INST_JUMP_TRUE, jumpDist, jumpPc); break; default: - TclUpdateInstInt4AtPc(INST_JUMP_FALSE4, jumpDist, jumpPc); + TclUpdateInstInt4AtPc(INST_JUMP_FALSE, jumpDist, jumpPc); break; } - - /* - * Adjust the code offsets for any commands and any ExceptionRange records - * between the jump and the current code address. - */ - - firstCmd = jumpFixupPtr->cmdIndex; - lastCmd = envPtr->numCommands - 1; - if (firstCmd < lastCmd) { - for (k = firstCmd; k <= lastCmd; k++) { - envPtr->cmdMapPtr[k].codeOffset += 3; - } - } - - firstRange = jumpFixupPtr->exceptIndex; - lastRange = envPtr->exceptArrayNext - 1; - for (k = firstRange; k <= lastRange; k++) { - ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[k]; - - rangePtr->codeOffset += 3; - switch (rangePtr->type) { - case LOOP_EXCEPTION_RANGE: - rangePtr->breakOffset += 3; - if (rangePtr->continueOffset != -1) { - rangePtr->continueOffset += 3; - } - break; - case CATCH_EXCEPTION_RANGE: - rangePtr->catchOffset += 3; - break; - default: - Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d", - rangePtr->type); - } - } - - /* - * TIP #280: Adjust the mapping from PC values to the per-command - * information about arguments and their line numbers. - * - * Note: We cannot simply remove an out-of-date entry and then reinsert - * with the proper PC, because then we might overwrite another entry which - * was at that location. Therefore we pull (copy + delete) all effected - * entries (beyond the fixed PC) into an array, update them there, and at - * last reinsert them all. - */ - - { - ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr; - - /* A helper structure */ - - typedef struct { - int pc; - int cmd; - } MAP; - - /* - * And the helper array. At most the whole hashtable is placed into - * this. - */ - - MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries); - - Tcl_HashSearch hSearch; - Tcl_HashEntry* hPtr; - int n, k, isnew; - - /* - * Phase I: Locate the affected entries, and save them in adjusted - * form to the array. This removes them from the hash. - */ - - for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch); - hPtr != NULL; - hPtr = Tcl_NextHashEntry(&hSearch)) { - - map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr)); - map [n].pc = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr)); - - if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) { - Tcl_DeleteHashEntry(hPtr); - map [n].pc += 3; - n++; - } - } - - /* - * Phase II: Re-insert the modified entries into the hash. - */ - - for (k=0;k<n;k++) { - hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew); - Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd)); - } - - ckfree (map); - } - - return 1; /* the jump was grown */ + return 0; } /* @@ -4359,16 +4443,12 @@ FormatInstruction( switch (instDesc->opTypes[i]) { case OPERAND_INT1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; - if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1 - || opCode == INST_JUMP_FALSE1) { - sprintf(suffixBuffer, "pc %u", pcOffset+opnd); - } Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_INT4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; - if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4 - || opCode == INST_JUMP_FALSE4) { + if (opCode == INST_JUMP || opCode == INST_JUMP_TRUE + || opCode == INST_JUMP_FALSE) { sprintf(suffixBuffer, "pc %u", pcOffset+opnd); } else if (opCode == INST_START_CMD) { sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd); @@ -4377,15 +4457,12 @@ FormatInstruction( break; case OPERAND_UINT1: opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++; - if (opCode == INST_PUSH1) { - suffixObj = codePtr->objArrayPtr[opnd]; - } Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd); break; case OPERAND_AUX4: case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; - if (opCode == INST_PUSH4) { + if (opCode == INST_PUSH) { suffixObj = codePtr->objArrayPtr[opnd]; } else if (opCode == INST_START_CMD && opnd != 1) { sprintf(suffixBuffer+strlen(suffixBuffer), @@ -4406,14 +4483,9 @@ FormatInstruction( Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd); } break; - case OPERAND_LVT1: - opnd = TclGetUInt1AtPtr(pc+numBytes); - numBytes++; - goto printLVTindex; case OPERAND_LVT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; - printLVTindex: if (localPtr != NULL) { if (opnd >= localCt) { Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)", @@ -4530,13 +4602,9 @@ TclGetInnerContext( objc = 2; break; - case INST_INVOKE_STK4: + case INST_INVOKE_STK: objc = TclGetUInt4AtPtr(pc+1); break; - - case INST_INVOKE_STK1: - objc = TclGetUInt1AtPtr(pc+1); - break; } result = iPtr->innerContext; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 4d8ed65..6171a49 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -455,266 +455,222 @@ typedef struct ByteCode { * tclExecute.c. */ -/* Opcodes 0 to 9 */ +/* Opcodes 0 to 7 */ #define INST_DONE 0 -#define INST_PUSH1 1 -#define INST_PUSH4 2 -#define INST_POP 3 -#define INST_DUP 4 -#define INST_CONCAT1 5 -#define INST_INVOKE_STK1 6 -#define INST_INVOKE_STK4 7 -#define INST_EVAL_STK 8 -#define INST_EXPR_STK 9 - -/* Opcodes 10 to 23 */ -#define INST_LOAD_SCALAR1 10 -#define INST_LOAD_SCALAR4 11 -#define INST_LOAD_SCALAR_STK 12 -#define INST_LOAD_ARRAY1 13 -#define INST_LOAD_ARRAY4 14 -#define INST_LOAD_ARRAY_STK 15 -#define INST_LOAD_STK 16 -#define INST_STORE_SCALAR1 17 -#define INST_STORE_SCALAR4 18 -#define INST_STORE_SCALAR_STK 19 -#define INST_STORE_ARRAY1 20 -#define INST_STORE_ARRAY4 21 -#define INST_STORE_ARRAY_STK 22 -#define INST_STORE_STK 23 - -/* Opcodes 24 to 33 */ -#define INST_INCR_SCALAR1 24 -#define INST_INCR_SCALAR_STK 25 -#define INST_INCR_ARRAY1 26 -#define INST_INCR_ARRAY_STK 27 -#define INST_INCR_STK 28 -#define INST_INCR_SCALAR1_IMM 29 -#define INST_INCR_SCALAR_STK_IMM 30 -#define INST_INCR_ARRAY1_IMM 31 -#define INST_INCR_ARRAY_STK_IMM 32 -#define INST_INCR_STK_IMM 33 - -/* Opcodes 34 to 39 */ -#define INST_JUMP1 34 -#define INST_JUMP4 35 -#define INST_JUMP_TRUE1 36 -#define INST_JUMP_TRUE4 37 -#define INST_JUMP_FALSE1 38 -#define INST_JUMP_FALSE4 39 - -/* Opcodes 40 to 64 */ -#define INST_LOR 40 -#define INST_LAND 41 -#define INST_BITOR 42 -#define INST_BITXOR 43 -#define INST_BITAND 44 -#define INST_EQ 45 -#define INST_NEQ 46 -#define INST_LT 47 -#define INST_GT 48 -#define INST_LE 49 -#define INST_GE 50 -#define INST_LSHIFT 51 -#define INST_RSHIFT 52 -#define INST_ADD 53 -#define INST_SUB 54 -#define INST_MULT 55 -#define INST_DIV 56 -#define INST_MOD 57 -#define INST_UPLUS 58 -#define INST_UMINUS 59 -#define INST_BITNOT 60 -#define INST_LNOT 61 -#define INST_CALL_BUILTIN_FUNC1 62 -#define INST_CALL_FUNC1 63 -#define INST_TRY_CVT_TO_NUMERIC 64 - -/* Opcodes 65 to 66 */ -#define INST_BREAK 65 -#define INST_CONTINUE 66 - -/* Opcodes 67 to 68 */ -#define INST_FOREACH_START4 67 -#define INST_FOREACH_STEP4 68 - -/* 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 */ -#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 78 to 81 */ -#define INST_LIST 79 -#define INST_LIST_INDEX 80 -#define INST_LIST_LENGTH 81 - -/* 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 */ -#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 +#define INST_PUSH 1 +#define INST_POP 2 +#define INST_DUP 3 +#define INST_CONCAT 4 +#define INST_INVOKE_STK 5 +#define INST_EVAL_STK 6 +#define INST_EXPR_STK 7 + +/* Opcodes 8 to 17: [set] */ +#define INST_LOAD_SCALAR 8 +#define INST_LOAD_SCALAR_STK 9 +#define INST_LOAD_ARRAY 10 +#define INST_LOAD_ARRAY_STK 11 +#define INST_LOAD_STK 12 +#define INST_STORE_SCALAR 13 +#define INST_STORE_SCALAR_STK 14 +#define INST_STORE_ARRAY 15 +#define INST_STORE_ARRAY_STK 16 +#define INST_STORE_STK 17 + +/* Opcodes 18 to 25: [incr] */ +#define INST_INCR_SCALAR 18 +#define INST_INCR_ARRAY 19 +#define INST_INCR_ARRAY_STK 20 +#define INST_INCR_STK 21 +#define INST_INCR_SCALAR_IMM 22 +#define INST_INCR_ARRAY_IMM 23 +#define INST_INCR_ARRAY_STK_IMM 24 +#define INST_INCR_STK_IMM 25 + +/* Opcodes 26 to 28 */ +#define INST_JUMP 26 +#define INST_JUMP_TRUE 27 +#define INST_JUMP_FALSE 28 + +/* Opcodes 29 to 54: operators */ +#define INST_LOR 29 +#define INST_LAND 30 +#define INST_BITOR 31 +#define INST_BITXOR 32 +#define INST_BITAND 33 +#define INST_EQ 34 +#define INST_NEQ 35 +#define INST_LT 36 +#define INST_GT 37 +#define INST_LE 38 +#define INST_GE 39 +#define INST_LSHIFT 40 +#define INST_RSHIFT 41 +#define INST_ADD 42 +#define INST_SUB 43 +#define INST_MULT 44 +#define INST_DIV 45 +#define INST_MOD 46 +#define INST_UPLUS 47 +#define INST_UMINUS 48 +#define INST_BITNOT 49 +#define INST_LNOT 50 +#define INST_TRY_CVT_TO_NUMERIC 51 +#define INST_EXPON 52 +#define INST_LIST_IN 53 +#define INST_LIST_NOT_IN 54 + +/* Opcodes 55 to 56: [foreach] */ +#define INST_FOREACH_START 55 +#define INST_FOREACH_STEP 56 + +/* Opcodes 57 to 66 */ +#define INST_BREAK 57 +#define INST_CONTINUE 58 +#define INST_BEGIN_CATCH 59 +#define INST_END_CATCH 60 +#define INST_PUSH_RESULT 61 +#define INST_PUSH_RETURN_CODE 62 +#define INST_PUSH_RETURN_OPTIONS 63 +#define INST_RETURN_STK 64 +#define INST_RETURN_IMM 65 +#define INST_RETURN_CODE_BRANCH 66 + +/* Opcodes 67 to 72 */ +#define INST_STR_EQ 67 +#define INST_STR_NEQ 68 +#define INST_STR_CMP 69 +#define INST_STR_LEN 70 +#define INST_STR_INDEX 71 +#define INST_STR_MATCH 72 + +/* Opcodes 73 to 75: list ops */ +#define INST_LIST 73 +#define INST_LIST_INDEX 74 +#define INST_LIST_LENGTH 75 + +/* Opcodes 76 to 79: [append] */ +#define INST_APPEND_SCALAR 76 +#define INST_APPEND_ARRAY 77 +#define INST_APPEND_ARRAY_STK 78 +#define INST_APPEND_STK 79 + +/* Opcodes 80 to 83: [lappend] */ +#define INST_LAPPEND_SCALAR 80 +#define INST_LAPPEND_ARRAY 81 +#define INST_LAPPEND_ARRAY_STK 82 +#define INST_LAPPEND_STK 83 /* TIP #22 - LINDEX operator with flat arg list */ +#define INST_LIST_INDEX_MULTI 84 -#define INST_LIST_INDEX_MULTI 94 - -/* - * TIP #33 - 'lset' command. Code gen also required a Forth-like - * OVER operation. - */ - -#define INST_OVER 95 -#define INST_LSET_LIST 96 -#define INST_LSET_FLAT 97 - -/* TIP#90 - 'return' command. */ - -#define INST_RETURN_IMM 98 - -/* TIP#123 - exponentiation operator. */ - -#define INST_EXPON 99 +/* TIP #33 - 'lset' command. */ +#define INST_LSET_LIST 85 +#define INST_LSET_FLAT 86 /* TIP #157 - {*}... (word expansion) language syntax support. */ - -#define INST_EXPAND_START 100 -#define INST_EXPAND_STKTOP 101 -#define INST_INVOKE_EXPANDED 102 +#define INST_EXPAND_START 87 +#define INST_EXPAND_STKTOP 88 +#define INST_INVOKE_EXPANDED 89 /* * TIP #57 - 'lassign' command. Code generation requires immediate * LINDEX and LRANGE operators. */ -#define INST_LIST_INDEX_IMM 103 -#define INST_LIST_RANGE_IMM 104 - -#define INST_START_CMD 105 - -#define INST_LIST_IN 106 -#define INST_LIST_NOT_IN 107 - -#define INST_PUSH_RETURN_OPTIONS 108 -#define INST_RETURN_STK 109 - -/* - * Dictionary (TIP#111) related commands. - */ - -#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 +#define INST_LIST_INDEX_IMM 90 +#define INST_LIST_RANGE_IMM 91 + +#define INST_START_CMD 92 + +/* Dictionary (TIP#111) related commands. */ +#define INST_DICT_GET 93 +#define INST_DICT_SET 94 +#define INST_DICT_UNSET 95 +#define INST_DICT_INCR_IMM 96 +#define INST_DICT_APPEND 97 +#define INST_DICT_LAPPEND 98 +#define INST_DICT_FIRST 99 +#define INST_DICT_NEXT 100 +#define INST_DICT_UPDATE_START 101 +#define INST_DICT_UPDATE_END 102 +#define INST_DICT_EXPAND 103 +#define INST_DICT_RECOMBINE_STK 104 +#define INST_DICT_RECOMBINE_IMM 105 +#define INST_DICT_EXISTS 106 +#define INST_DICT_VERIFY 107 /* * Instruction to support jumps defined by tables (instead of the classic * [switch] technique of chained comparisons). */ -#define INST_JUMP_TABLE 121 +#define INST_JUMP_TABLE 108 /* * Instructions to support compilation of global, variable, upvar and * [namespace upvar]. */ -#define INST_UPVAR 122 -#define INST_NSUPVAR 123 -#define INST_VARIABLE 124 +#define INST_UPVAR 109 +#define INST_NSUPVAR 110 +#define INST_VARIABLE 111 -/* Instruction to support compiling syntax error to bytecode */ - -#define INST_SYNTAX 125 - -/* Instruction to reverse N items on top of stack */ - -#define INST_REVERSE 126 +/* Utilities */ +#define INST_OVER 112 +#define INST_SYNTAX 113 +#define INST_REVERSE 114 +#define INST_NOP 115 /* regexp instruction */ - -#define INST_REGEXP 127 +#define INST_REGEXP 116 /* 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 - -/* For [subst] compilation */ -#define INST_NOP 132 -#define INST_RETURN_CODE_BRANCH 133 +#define INST_EXIST_SCALAR 117 +#define INST_EXIST_ARRAY 118 +#define INST_EXIST_ARRAY_STK 119 +#define INST_EXIST_STK 120 /* For [unset] compilation */ -#define INST_UNSET_SCALAR 134 -#define INST_UNSET_ARRAY 135 -#define INST_UNSET_ARRAY_STK 136 -#define INST_UNSET_STK 137 - -/* 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 +#define INST_UNSET_SCALAR 121 +#define INST_UNSET_ARRAY 122 +#define INST_UNSET_ARRAY_STK 123 +#define INST_UNSET_STK 124 /* 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 +#define INST_STR_MAP 125 +#define INST_STR_FIND 126 +#define INST_STR_FIND_LAST 127 +#define INST_STR_RANGE_IMM 128 +#define INST_STR_RANGE 129 /* For operations to do with coroutines and other NRE-manipulators */ -#define INST_YIELD 148 -#define INST_COROUTINE_NAME 149 -#define INST_TAILCALL 150 +#define INST_YIELD 130 +#define INST_COROUTINE_NAME 131 +#define INST_TAILCALL 132 /* 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 -#define INST_TCLOO_SELF 155 -#define INST_TCLOO_CLASS 156 -#define INST_TCLOO_NS 157 -#define INST_TCLOO_IS_OBJECT 158 +#define INST_NS_CURRENT 133 +#define INST_INFO_LEVEL_NUM 134 +#define INST_INFO_LEVEL_ARGS 135 +#define INST_RESOLVE_COMMAND 136 +#define INST_TCLOO_SELF 137 +#define INST_TCLOO_CLASS 138 +#define INST_TCLOO_NS 139 +#define INST_TCLOO_IS_OBJECT 140 /* 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_ARRAY_EXISTS_STK 141 +#define INST_ARRAY_EXISTS_IMM 142 +#define INST_ARRAY_MAKE_STK 143 +#define INST_ARRAY_MAKE_IMM 144 -#define INST_INVOKE_REPLACE 163 +#define INST_EXCH 145 +#define INST_UNDER 146 +#define INST_INVOKE_REPLACE 147 /* The last opcode */ -#define LAST_INST_OPCODE 163 +#define LAST_INST_OPCODE 147 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -735,8 +691,6 @@ typedef enum InstOperandType { OPERAND_UINT4, /* Four byte unsigned integer. */ OPERAND_IDX4, /* Four byte signed index (actually an * integer, but displayed differently.) */ - OPERAND_LVT1, /* One byte unsigned index into the local - * variable table. */ OPERAND_LVT4, /* Four byte unsigned index into the local * variable table. */ OPERAND_AUX4 /* Four byte unsigned index into the aux data @@ -987,6 +941,11 @@ MODULE_SCOPE void TclPrintObject(FILE *outFile, Tcl_Obj *objPtr, int maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, const char *string, int maxChars); +MODULE_SCOPE int TclPushVarName(Tcl_Interp *interp, + Tcl_Token *varTokenPtr, CompileEnv *envPtr, + int flags, int *localIndexPtr, + int *simpleVarNamePtr, int *isScalarPtr, + int line, int *clNext); MODULE_SCOPE void TclRegisterAuxDataType(const AuxDataType *typePtr); MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr, char *bytes, int length, int flags); @@ -1012,11 +971,11 @@ MODULE_SCOPE void TclVerifyLocalLiteralTable(CompileEnv *envPtr); MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, - const char *script, - const char *command, int length, - const unsigned char *pc, Tcl_Obj **tosPtr); + const char *script, const char *command, + int length, const unsigned char *pc, + Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, - const unsigned char *pc, Tcl_Obj **tosPtr); + const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); @@ -1191,11 +1150,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #define TclEmitPush(objIndex, envPtr) \ do { \ register int objIndexCopy = (objIndex); \ - if (objIndexCopy <= 255) { \ - TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \ - } \ + TclEmitInstInt4(INST_PUSH, objIndexCopy, (envPtr)); \ } while (0) /* @@ -1330,6 +1285,7 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); #define CompileTokens(envPtr, tokenPtr, interp) \ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ (envPtr)); + /* * Convenience macro for use when pushing literals. The ANSI C "prototype" for * this macro is: @@ -1362,11 +1318,10 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); ((envPtr)->codeNext - (envPtr)->codeStart) /* - * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the - * maximal depth of nested CATCH ranges in order to alloc runtime - * memory. These macros should compute precisely that? OTOH, the nesting depth - * of LOOP ranges is an interesting datum for debugging purposes, and that is - * what we compute now. + * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the maximal + * depth of nested CATCH ranges in order to alloc runtime memory. These macros + * should compute precisely that? OTOH, the nesting depth of LOOP ranges is an + * interesting datum for debugging purposes, and that is what we compute now. * * static int DeclareExceptionRange(CompileEnv *envPtr, int type); * static int ExceptionRangeStarts(CompileEnv *envPtr, int index); @@ -1389,12 +1344,16 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr)) /* - * Check if there is an LVT for compiled locals + * Check if there is an LVT for compiled locals, and issuing a new private + * variable. */ #define EnvHasLVT(envPtr) \ (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr) +#define NewUnnamedLocal(envPtr) \ + TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)) + /* * Macros for making it easier to deal with tokens and DStrings. */ @@ -1406,6 +1365,132 @@ MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); Tcl_DStringLength(dsPtr), /*flags*/ 0) /* + * Macro that encapsulates an efficiency trick that avoids a function call for + * the simplest of compiles. The ANSI C "prototype" for this macro is: + * + * static void CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr, + * Tcl_Interp *interp, int word); + */ + +#define CompileWord(envPtr, tokenPtr, interp, word) \ + if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \ + TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ + (tokenPtr)[1].size), (envPtr)); \ + } else { \ + envPtr->line = mapPtr->loc[eclIndex].line[word]; \ + envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ + TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ + (envPtr)); \ + } + +/* + * TIP #280: Remember the per-word line information of the current command. An + * index is used instead of a pointer as recursive compilation may reallocate, + * i.e. move, the array. This is also the reason to save the nuloc now, it may + * change during the course of the function. + * + * Macro to encapsulate the variable definition and setup. + */ + +#define DefineLineInformation \ + ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ + int eclIndex = mapPtr->nuloc - 1 + +#define SetLineInformation(word) \ + do { \ + envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ + envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]; \ + } while (0) + +#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ + TclPushVarName(i,v,e,f,l,s,sc, \ + mapPtr->loc[eclIndex].line[(word)], \ + mapPtr->loc[eclIndex].next[(word)]) + +/* + * Flags bits used by TclPushVarName. + */ + +#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */ +#define TCL_NO_ELEMENT 2 /* Do not push the array element. */ + +/* + * Shorthand macros for instruction issuing. Note that these assume that there + * are variables in the current environment called 'envPtr' and 'interp', and + * also that there are no side effects in the arguments given. + */ + +#define OP(name) TclEmitOpcode(INST_##name, envPtr) +#define OP1(name,val) TclEmitInstInt1(INST_##name, (val), envPtr) +#define OP4(name,val) TclEmitInstInt4(INST_##name, (val), envPtr) +#define OP14(name,val1,val2) \ + do { \ + TclEmitInstInt1(INST_##name, (val1), envPtr); \ + TclEmitInt4((val2), envPtr); \ + } while (0) +#define OP41(name,val1,val2) \ + do { \ + TclEmitInstInt4(INST_##name, (val1), envPtr); \ + TclEmitInt1((val2), envPtr); \ + } while (0) +#define OP44(name,val1,val2) \ + do { \ + TclEmitInstInt4(INST_##name, (val1), envPtr); \ + TclEmitInt4((val2), envPtr); \ + } while (0) +#define BODY(token,index) \ + do { \ + SetLineInformation((index)); \ + CompileBody(envPtr, (token), interp); \ + } while (0) +#define PUSH(str) \ + PushLiteral(envPtr, (str), strlen(str)) +#define PUSH_SUBST_WORD(token,index) \ + do { \ + Tcl_Token *theTokenToCompile = (token); \ + int theIndex = (index); \ + CompileWord(envPtr, theTokenToCompile, interp, theIndex); \ + } while (0) +#define PUSH_EXPR_WORD(token,index) \ + do { \ + Tcl_Token *theTokenToCompile = (token); \ + int theIndex = (index); \ + SetLineInformation(theIndex); \ + TclCompileExprWords(interp, theTokenToCompile, 1, envPtr); \ + } while (0) +#define PUSH_VAR(v,word,l,s,sc) \ + TclPushVarName(interp,(v),envPtr,0,(l),(s),(sc), \ + mapPtr->loc[eclIndex].line[(word)], \ + mapPtr->loc[eclIndex].next[(word)]) +#define PUSH_OBJ(obj) \ + do { \ + int objLength; \ + char *objBytes = Tcl_GetStringFromObj((obj), &objLength); \ + PushLiteral(envPtr, objBytes, objLength); \ + } while (0) +#define PUSH_DSTRING(dsPtr) \ + PushLiteral(envPtr, Tcl_DStringValue((dsPtr)), Tcl_DStringLength((dsPtr))) +#define LABEL(var) \ + ((var) = CurrentOffset(envPtr)) +#define BACKJUMP(var,name) \ + do { \ + int theOffset = (var) - CurrentOffset(envPtr); \ + TclEmitInstInt4(INST_##name, theOffset, envPtr); \ + } while (0) +#define JUMP(var,name) \ + do { \ + (var) = CurrentOffset(envPtr); \ + TclEmitInstInt4(INST_##name, 0, envPtr); \ + } while (0) +#define FIXJUMP(var) \ + do { \ + if ((var) >= 0) { \ + TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var), \ + envPtr->codeStart+(var)+1); \ + } \ + } while (0) + +/* * DTrace probe macros (NOPs if DTrace support is not enabled). */ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index fe9ba2b..030bca7 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -12,17 +12,6 @@ #ifndef _TCLDECLS #define _TCLDECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -36,1779 +25,1747 @@ */ /* 0 */ -EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp, +TCLAPI int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 1 */ -EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, +TCLAPI const char * Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 2 */ -EXTERN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); +TCLAPI void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 3 */ -EXTERN char * Tcl_Alloc(unsigned int size); +TCLAPI char * Tcl_Alloc(unsigned int size); /* 4 */ -EXTERN void Tcl_Free(char *ptr); +TCLAPI void Tcl_Free(char *ptr); /* 5 */ -EXTERN char * Tcl_Realloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_Realloc(char *ptr, unsigned int size); /* 6 */ -EXTERN char * Tcl_DbCkalloc(unsigned int size, const char *file, +TCLAPI char * Tcl_DbCkalloc(unsigned int size, const char *file, int line); /* 7 */ -EXTERN void Tcl_DbCkfree(char *ptr, const char *file, int line); +TCLAPI void Tcl_DbCkfree(char *ptr, const char *file, int line); /* 8 */ -EXTERN char * Tcl_DbCkrealloc(char *ptr, unsigned int size, +TCLAPI char * Tcl_DbCkrealloc(char *ptr, unsigned int size, const char *file, int line); #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 9 */ -EXTERN void Tcl_CreateFileHandler(int fd, int mask, +TCLAPI void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 9 */ -EXTERN void Tcl_CreateFileHandler(int fd, int mask, +TCLAPI void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc, ClientData clientData); #endif /* MACOSX */ #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 10 */ -EXTERN void Tcl_DeleteFileHandler(int fd); +TCLAPI void Tcl_DeleteFileHandler(int fd); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 10 */ -EXTERN void Tcl_DeleteFileHandler(int fd); +TCLAPI void Tcl_DeleteFileHandler(int fd); #endif /* MACOSX */ /* 11 */ -EXTERN void Tcl_SetTimer(const Tcl_Time *timePtr); +TCLAPI void Tcl_SetTimer(const Tcl_Time *timePtr); /* 12 */ -EXTERN void Tcl_Sleep(int ms); +TCLAPI void Tcl_Sleep(int ms); /* 13 */ -EXTERN int Tcl_WaitForEvent(const Tcl_Time *timePtr); +TCLAPI int Tcl_WaitForEvent(const Tcl_Time *timePtr); /* 14 */ -EXTERN int Tcl_AppendAllObjTypes(Tcl_Interp *interp, +TCLAPI int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 15 */ -EXTERN void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); +TCLAPI void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...); /* 16 */ -EXTERN void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, +TCLAPI void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length); /* 17 */ -EXTERN Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); +TCLAPI Tcl_Obj * Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]); /* 18 */ -EXTERN int Tcl_ConvertToType(Tcl_Interp *interp, +TCLAPI int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 19 */ -EXTERN void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, +TCLAPI void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 20 */ -EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, +TCLAPI void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line); /* 21 */ -EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, +TCLAPI int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line); /* 22 */ -EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, +TCLAPI Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file, int line); /* 23 */ -EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, +TCLAPI Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length, const char *file, int line); /* 24 */ -EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, +TCLAPI Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue, const char *file, int line); /* 25 */ -EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, +TCLAPI Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv, const char *file, int line); /* 26 */ -EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, +TCLAPI Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file, int line); /* 27 */ -EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line); +TCLAPI Tcl_Obj * Tcl_DbNewObj(const char *file, int line); /* 28 */ -EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, +TCLAPI Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length, const char *file, int line); /* 29 */ -EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); +TCLAPI Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr); /* 30 */ -EXTERN void TclFreeObj(Tcl_Obj *objPtr); +TCLAPI void TclFreeObj(Tcl_Obj *objPtr); /* 31 */ -EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, +TCLAPI int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr); /* 32 */ -EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 33 */ -EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, +TCLAPI unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 34 */ -EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, +TCLAPI int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); /* 35 */ -EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ -EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, +TCLAPI int Tcl_GetIndexFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 37 */ -EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, +TCLAPI int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr); /* 38 */ -EXTERN int Tcl_GetIntFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 39 */ -EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 40 */ -EXTERN CONST86 Tcl_ObjType * Tcl_GetObjType(const char *typeName); +TCLAPI const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ -EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); +TCLAPI char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 42 */ -EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); +TCLAPI void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ -EXTERN int Tcl_ListObjAppendList(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjAppendList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 44 */ -EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ -EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ -EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 47 */ -EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 48 */ -EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, +TCLAPI int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 49 */ -EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue); +TCLAPI Tcl_Obj * Tcl_NewBooleanObj(int boolValue); /* 50 */ -EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, +TCLAPI Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes, int length); /* 51 */ -EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); +TCLAPI Tcl_Obj * Tcl_NewDoubleObj(double doubleValue); /* 52 */ -EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue); +TCLAPI Tcl_Obj * Tcl_NewIntObj(int intValue); /* 53 */ -EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); +TCLAPI Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]); /* 54 */ -EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue); +TCLAPI Tcl_Obj * Tcl_NewLongObj(long longValue); /* 55 */ -EXTERN Tcl_Obj * Tcl_NewObj(void); +TCLAPI Tcl_Obj * Tcl_NewObj(void); /* 56 */ -EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); +TCLAPI Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length); /* 57 */ -EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); +TCLAPI void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue); /* 58 */ -EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); +TCLAPI unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length); /* 59 */ -EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 60 */ -EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); +TCLAPI void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue); /* 61 */ -EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); +TCLAPI void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue); /* 62 */ -EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, +TCLAPI void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 63 */ -EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); +TCLAPI void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue); /* 64 */ -EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); +TCLAPI void Tcl_SetObjLength(Tcl_Obj *objPtr, int length); /* 65 */ -EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, +TCLAPI void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length); /* 66 */ -EXTERN void Tcl_AddErrorInfo(Tcl_Interp *interp, +TCLAPI void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message); /* 67 */ -EXTERN void Tcl_AddObjErrorInfo(Tcl_Interp *interp, +TCLAPI void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, int length); /* 68 */ -EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp); +TCLAPI void Tcl_AllowExceptions(Tcl_Interp *interp); /* 69 */ -EXTERN void Tcl_AppendElement(Tcl_Interp *interp, +TCLAPI void Tcl_AppendElement(Tcl_Interp *interp, const char *element); /* 70 */ -EXTERN void Tcl_AppendResult(Tcl_Interp *interp, ...); +TCLAPI void Tcl_AppendResult(Tcl_Interp *interp, ...); /* 71 */ -EXTERN Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, +TCLAPI Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc, ClientData clientData); /* 72 */ -EXTERN void Tcl_AsyncDelete(Tcl_AsyncHandler async); +TCLAPI void Tcl_AsyncDelete(Tcl_AsyncHandler async); /* 73 */ -EXTERN int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); +TCLAPI int Tcl_AsyncInvoke(Tcl_Interp *interp, int code); /* 74 */ -EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async); +TCLAPI void Tcl_AsyncMark(Tcl_AsyncHandler async); /* 75 */ -EXTERN int Tcl_AsyncReady(void); +TCLAPI int Tcl_AsyncReady(void); /* 76 */ -EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); -/* 77 */ -EXTERN char Tcl_Backslash(const char *src, int *readPtr); +TCLAPI void Tcl_BackgroundError(Tcl_Interp *interp); +/* Slot 77 is reserved */ /* 78 */ -EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, +TCLAPI int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, const char *optionList); /* 79 */ -EXTERN void Tcl_CallWhenDeleted(Tcl_Interp *interp, +TCLAPI void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 80 */ -EXTERN void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, +TCLAPI void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData); /* 81 */ -EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); +TCLAPI int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ -EXTERN int Tcl_CommandComplete(const char *cmd); +TCLAPI int Tcl_CommandComplete(const char *cmd); /* 83 */ -EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv); +TCLAPI char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ -EXTERN int Tcl_ConvertElement(const char *src, char *dst, +TCLAPI int Tcl_ConvertElement(const char *src, char *dst, int flags); /* 85 */ -EXTERN int Tcl_ConvertCountedElement(const char *src, +TCLAPI int Tcl_ConvertCountedElement(const char *src, int length, char *dst, int flags); /* 86 */ -EXTERN int Tcl_CreateAlias(Tcl_Interp *slave, +TCLAPI int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, - CONST84 char *const *argv); + const char *const *argv); /* 87 */ -EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave, +TCLAPI int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 88 */ -EXTERN Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, +TCLAPI Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 89 */ -EXTERN void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, +TCLAPI void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 90 */ -EXTERN void Tcl_CreateCloseHandler(Tcl_Channel chan, +TCLAPI void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 91 */ -EXTERN Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 92 */ -EXTERN void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, +TCLAPI void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 93 */ -EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 94 */ -EXTERN Tcl_Interp * Tcl_CreateInterp(void); -/* 95 */ -EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp, - const char *name, int numArgs, - Tcl_ValueType *argTypes, Tcl_MathProc *proc, - ClientData clientData); +TCLAPI Tcl_Interp * Tcl_CreateInterp(void); +/* Slot 95 is reserved */ /* 96 */ -EXTERN Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 97 */ -EXTERN Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, +TCLAPI Tcl_Interp * Tcl_CreateSlave(Tcl_Interp *interp, const char *slaveName, int isSafe); /* 98 */ -EXTERN Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, +TCLAPI Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 99 */ -EXTERN Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, +TCLAPI Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 100 */ -EXTERN void Tcl_DeleteAssocData(Tcl_Interp *interp, +TCLAPI void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name); /* 101 */ -EXTERN void Tcl_DeleteChannelHandler(Tcl_Channel chan, +TCLAPI void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 102 */ -EXTERN void Tcl_DeleteCloseHandler(Tcl_Channel chan, +TCLAPI void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 103 */ -EXTERN int Tcl_DeleteCommand(Tcl_Interp *interp, +TCLAPI int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName); /* 104 */ -EXTERN int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, +TCLAPI int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command); /* 105 */ -EXTERN void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, +TCLAPI void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData); /* 106 */ -EXTERN void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, +TCLAPI void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 107 */ -EXTERN void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 108 */ -EXTERN void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); +TCLAPI void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr); /* 109 */ -EXTERN void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr); +TCLAPI void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr); /* 110 */ -EXTERN void Tcl_DeleteInterp(Tcl_Interp *interp); +TCLAPI void Tcl_DeleteInterp(Tcl_Interp *interp); /* 111 */ -EXTERN void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr); +TCLAPI void Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr); /* 112 */ -EXTERN void Tcl_DeleteTimerHandler(Tcl_TimerToken token); +TCLAPI void Tcl_DeleteTimerHandler(Tcl_TimerToken token); /* 113 */ -EXTERN void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); +TCLAPI void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace); /* 114 */ -EXTERN void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, +TCLAPI void Tcl_DontCallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 115 */ -EXTERN int Tcl_DoOneEvent(int flags); +TCLAPI int Tcl_DoOneEvent(int flags); /* 116 */ -EXTERN void Tcl_DoWhenIdle(Tcl_IdleProc *proc, +TCLAPI void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData); /* 117 */ -EXTERN char * Tcl_DStringAppend(Tcl_DString *dsPtr, +TCLAPI char * Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length); /* 118 */ -EXTERN char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, +TCLAPI char * Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element); /* 119 */ -EXTERN void Tcl_DStringEndSublist(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringEndSublist(Tcl_DString *dsPtr); /* 120 */ -EXTERN void Tcl_DStringFree(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringFree(Tcl_DString *dsPtr); /* 121 */ -EXTERN void Tcl_DStringGetResult(Tcl_Interp *interp, +TCLAPI void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 122 */ -EXTERN void Tcl_DStringInit(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringInit(Tcl_DString *dsPtr); /* 123 */ -EXTERN void Tcl_DStringResult(Tcl_Interp *interp, +TCLAPI void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr); /* 124 */ -EXTERN void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); +TCLAPI void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length); /* 125 */ -EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); +TCLAPI void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ -EXTERN int Tcl_Eof(Tcl_Channel chan); +TCLAPI int Tcl_Eof(Tcl_Channel chan); /* 127 */ -EXTERN CONST84_RETURN char * Tcl_ErrnoId(void); +TCLAPI const char * Tcl_ErrnoId(void); /* 128 */ -EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err); +TCLAPI const char * Tcl_ErrnoMsg(int err); /* 129 */ -EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); -/* 130 */ -EXTERN int Tcl_EvalFile(Tcl_Interp *interp, - const char *fileName); +TCLAPI int Tcl_Eval(Tcl_Interp *interp, const char *script); +/* Slot 130 is reserved */ /* 131 */ -EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +TCLAPI int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 132 */ -EXTERN void Tcl_EventuallyFree(ClientData clientData, +TCLAPI void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc); /* 133 */ -EXTERN void Tcl_Exit(int status); +TCLAPI void Tcl_Exit(int status); /* 134 */ -EXTERN int Tcl_ExposeCommand(Tcl_Interp *interp, +TCLAPI int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 135 */ -EXTERN int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, +TCLAPI int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, int *ptr); /* 136 */ -EXTERN int Tcl_ExprBooleanObj(Tcl_Interp *interp, +TCLAPI int Tcl_ExprBooleanObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 137 */ -EXTERN int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, +TCLAPI int Tcl_ExprDouble(Tcl_Interp *interp, const char *expr, double *ptr); /* 138 */ -EXTERN int Tcl_ExprDoubleObj(Tcl_Interp *interp, +TCLAPI int Tcl_ExprDoubleObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 139 */ -EXTERN int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, +TCLAPI int Tcl_ExprLong(Tcl_Interp *interp, const char *expr, long *ptr); /* 140 */ -EXTERN int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 141 */ -EXTERN int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 142 */ -EXTERN int Tcl_ExprString(Tcl_Interp *interp, const char *expr); +TCLAPI int Tcl_ExprString(Tcl_Interp *interp, const char *expr); /* 143 */ -EXTERN void Tcl_Finalize(void); -/* 144 */ -EXTERN void Tcl_FindExecutable(const char *argv0); +TCLAPI void Tcl_Finalize(void); +/* Slot 144 is reserved */ /* 145 */ -EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, +TCLAPI Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ -EXTERN int Tcl_Flush(Tcl_Channel chan); +TCLAPI int Tcl_Flush(Tcl_Channel chan); /* 147 */ -EXTERN void Tcl_FreeResult(Tcl_Interp *interp); +TCLAPI void Tcl_FreeResult(Tcl_Interp *interp); /* 148 */ -EXTERN int Tcl_GetAlias(Tcl_Interp *interp, +TCLAPI int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, - CONST84 char **targetCmdPtr, int *argcPtr, - CONST84 char ***argvPtr); + const char **targetCmdPtr, int *argcPtr, + const char ***argvPtr); /* 149 */ -EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, - CONST84 char **targetCmdPtr, int *objcPtr, + const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ -EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, +TCLAPI ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ -EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr); /* 152 */ -EXTERN int Tcl_GetChannelBufferSize(Tcl_Channel chan); +TCLAPI int Tcl_GetChannelBufferSize(Tcl_Channel chan); /* 153 */ -EXTERN int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, +TCLAPI int Tcl_GetChannelHandle(Tcl_Channel chan, int direction, ClientData *handlePtr); /* 154 */ -EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); +TCLAPI ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ -EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); +TCLAPI int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ -EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan); +TCLAPI const char * Tcl_GetChannelName(Tcl_Channel chan); /* 157 */ -EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, +TCLAPI int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 158 */ -EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); +TCLAPI const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); /* 159 */ -EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, +TCLAPI int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 160 */ -EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp, +TCLAPI const char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command); /* 161 */ -EXTERN int Tcl_GetErrno(void); +TCLAPI int Tcl_GetErrno(void); /* 162 */ -EXTERN CONST84_RETURN char * Tcl_GetHostName(void); +TCLAPI const char * Tcl_GetHostName(void); /* 163 */ -EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp, +TCLAPI int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 164 */ -EXTERN Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp); +TCLAPI Tcl_Interp * Tcl_GetMaster(Tcl_Interp *interp); /* 165 */ -EXTERN const char * Tcl_GetNameOfExecutable(void); +TCLAPI const char * Tcl_GetNameOfExecutable(void); /* 166 */ -EXTERN Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); +TCLAPI Tcl_Obj * Tcl_GetObjResult(Tcl_Interp *interp); #if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 167 */ -EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, +TCLAPI int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); #endif /* UNIX */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 167 */ -EXTERN int Tcl_GetOpenFile(Tcl_Interp *interp, +TCLAPI int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, ClientData *filePtr); #endif /* MACOSX */ /* 168 */ -EXTERN Tcl_PathType Tcl_GetPathType(const char *path); +TCLAPI Tcl_PathType Tcl_GetPathType(const char *path); /* 169 */ -EXTERN int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); +TCLAPI int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr); /* 170 */ -EXTERN int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); +TCLAPI int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 171 */ -EXTERN int Tcl_GetServiceMode(void); +TCLAPI int Tcl_GetServiceMode(void); /* 172 */ -EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, +TCLAPI Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName); /* 173 */ -EXTERN Tcl_Channel Tcl_GetStdChannel(int type); +TCLAPI Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ -EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp); +TCLAPI const char * Tcl_GetStringResult(Tcl_Interp *interp); /* 175 */ -EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, - const char *varName, int flags); -/* 176 */ -EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, +TCLAPI const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags); -/* 177 */ -EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, - const char *command); -/* 178 */ -EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); +/* 176 */ +TCLAPI const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, + const char *part2, int flags); +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ /* 179 */ -EXTERN int Tcl_HideCommand(Tcl_Interp *interp, +TCLAPI int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 180 */ -EXTERN int Tcl_Init(Tcl_Interp *interp); +TCLAPI int Tcl_Init(Tcl_Interp *interp); /* 181 */ -EXTERN void Tcl_InitHashTable(Tcl_HashTable *tablePtr, +TCLAPI void Tcl_InitHashTable(Tcl_HashTable *tablePtr, int keyType); /* 182 */ -EXTERN int Tcl_InputBlocked(Tcl_Channel chan); +TCLAPI int Tcl_InputBlocked(Tcl_Channel chan); /* 183 */ -EXTERN int Tcl_InputBuffered(Tcl_Channel chan); +TCLAPI int Tcl_InputBuffered(Tcl_Channel chan); /* 184 */ -EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp); +TCLAPI int Tcl_InterpDeleted(Tcl_Interp *interp); /* 185 */ -EXTERN int Tcl_IsSafe(Tcl_Interp *interp); +TCLAPI int Tcl_IsSafe(Tcl_Interp *interp); /* 186 */ -EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv, +TCLAPI char * Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr); /* 187 */ -EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, +TCLAPI int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr, int type); /* Slot 188 is reserved */ /* 189 */ -EXTERN Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); +TCLAPI Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode); /* 190 */ -EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); +TCLAPI int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ -EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); +TCLAPI Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); /* 192 */ -EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv); +TCLAPI char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ -EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); +TCLAPI Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); /* 194 */ -EXTERN void Tcl_NotifyChannel(Tcl_Channel channel, int mask); +TCLAPI void Tcl_NotifyChannel(Tcl_Channel channel, int mask); /* 195 */ -EXTERN Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, +TCLAPI Tcl_Obj * Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 196 */ -EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, +TCLAPI Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 197 */ -EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, - CONST84 char **argv, int flags); +TCLAPI Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, + const char **argv, int flags); /* 198 */ -EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 199 */ -EXTERN Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, +TCLAPI Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 200 */ -EXTERN Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, +TCLAPI Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 201 */ -EXTERN void Tcl_Preserve(ClientData data); +TCLAPI void Tcl_Preserve(ClientData data); /* 202 */ -EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, +TCLAPI void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst); /* 203 */ -EXTERN int Tcl_PutEnv(const char *assignment); +TCLAPI int Tcl_PutEnv(const char *assignment); /* 204 */ -EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp); +TCLAPI const char * Tcl_PosixError(Tcl_Interp *interp); /* 205 */ -EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, +TCLAPI void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); /* 206 */ -EXTERN int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); +TCLAPI int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead); /* 207 */ -EXTERN void Tcl_ReapDetachedProcs(void); +TCLAPI void Tcl_ReapDetachedProcs(void); /* 208 */ -EXTERN int Tcl_RecordAndEval(Tcl_Interp *interp, +TCLAPI int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags); /* 209 */ -EXTERN int Tcl_RecordAndEvalObj(Tcl_Interp *interp, +TCLAPI int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 210 */ -EXTERN void Tcl_RegisterChannel(Tcl_Interp *interp, +TCLAPI void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 211 */ -EXTERN void Tcl_RegisterObjType(const Tcl_ObjType *typePtr); +TCLAPI void Tcl_RegisterObjType(const Tcl_ObjType *typePtr); /* 212 */ -EXTERN Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, +TCLAPI Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern); /* 213 */ -EXTERN int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, +TCLAPI int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 214 */ -EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, +TCLAPI int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ -EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, - CONST84 char **startPtr, - CONST84 char **endPtr); +TCLAPI void Tcl_RegExpRange(Tcl_RegExp regexp, int index, + const char **startPtr, const char **endPtr); /* 216 */ -EXTERN void Tcl_Release(ClientData clientData); +TCLAPI void Tcl_Release(ClientData clientData); /* 217 */ -EXTERN void Tcl_ResetResult(Tcl_Interp *interp); +TCLAPI void Tcl_ResetResult(Tcl_Interp *interp); /* 218 */ -EXTERN int Tcl_ScanElement(const char *src, int *flagPtr); +TCLAPI int Tcl_ScanElement(const char *src, int *flagPtr); /* 219 */ -EXTERN int Tcl_ScanCountedElement(const char *src, int length, +TCLAPI int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr); -/* 220 */ -EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode); +/* Slot 220 is reserved */ /* 221 */ -EXTERN int Tcl_ServiceAll(void); +TCLAPI int Tcl_ServiceAll(void); /* 222 */ -EXTERN int Tcl_ServiceEvent(int flags); +TCLAPI int Tcl_ServiceEvent(int flags); /* 223 */ -EXTERN void Tcl_SetAssocData(Tcl_Interp *interp, +TCLAPI void Tcl_SetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 224 */ -EXTERN void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); +TCLAPI void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz); /* 225 */ -EXTERN int Tcl_SetChannelOption(Tcl_Interp *interp, +TCLAPI int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 226 */ -EXTERN int Tcl_SetCommandInfo(Tcl_Interp *interp, +TCLAPI int Tcl_SetCommandInfo(Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 227 */ -EXTERN void Tcl_SetErrno(int err); +TCLAPI void Tcl_SetErrno(int err); /* 228 */ -EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); +TCLAPI void Tcl_SetErrorCode(Tcl_Interp *interp, ...); /* 229 */ -EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); +TCLAPI void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ -EXTERN void Tcl_SetPanicProc(Tcl_PanicProc *panicProc); +TCLAPI void Tcl_SetPanicProc(Tcl_PanicProc *panicProc); /* 231 */ -EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); +TCLAPI int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); /* 232 */ -EXTERN void Tcl_SetResult(Tcl_Interp *interp, char *result, +TCLAPI void Tcl_SetResult(Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 233 */ -EXTERN int Tcl_SetServiceMode(int mode); +TCLAPI int Tcl_SetServiceMode(int mode); /* 234 */ -EXTERN void Tcl_SetObjErrorCode(Tcl_Interp *interp, +TCLAPI void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 235 */ -EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, +TCLAPI void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 236 */ -EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); +TCLAPI void Tcl_SetStdChannel(Tcl_Channel channel, int type); /* 237 */ -EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, - const char *varName, const char *newValue, - int flags); -/* 238 */ -EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, +TCLAPI const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags); +/* 238 */ +TCLAPI const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, + const char *part2, const char *newValue, + int flags); /* 239 */ -EXTERN CONST84_RETURN char * Tcl_SignalId(int sig); +TCLAPI const char * Tcl_SignalId(int sig); /* 240 */ -EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig); +TCLAPI const char * Tcl_SignalMsg(int sig); /* 241 */ -EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); +TCLAPI void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ -EXTERN int Tcl_SplitList(Tcl_Interp *interp, +TCLAPI int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, - CONST84 char ***argvPtr); + const char ***argvPtr); /* 243 */ -EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, - CONST84 char ***argvPtr); +TCLAPI void Tcl_SplitPath(const char *path, int *argcPtr, + const char ***argvPtr); /* 244 */ -EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, +TCLAPI void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 245 */ -EXTERN int Tcl_StringMatch(const char *str, const char *pattern); -/* 246 */ -EXTERN int Tcl_TellOld(Tcl_Channel chan); +TCLAPI int Tcl_StringMatch(const char *str, const char *pattern); +/* Slot 246 is reserved */ /* 247 */ -EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, +TCLAPI int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */ -EXTERN int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, +TCLAPI int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 249 */ -EXTERN char * Tcl_TranslateFileName(Tcl_Interp *interp, +TCLAPI char * Tcl_TranslateFileName(Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 250 */ -EXTERN int Tcl_Ungets(Tcl_Channel chan, const char *str, +TCLAPI int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead); /* 251 */ -EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp, +TCLAPI void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName); /* 252 */ -EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp, +TCLAPI int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 253 */ -EXTERN int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, +TCLAPI int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags); /* 254 */ -EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, +TCLAPI int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 255 */ -EXTERN void Tcl_UntraceVar(Tcl_Interp *interp, +TCLAPI void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ -EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp, +TCLAPI void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 257 */ -EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp, +TCLAPI void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName); /* 258 */ -EXTERN int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, +TCLAPI int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 259 */ -EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, +TCLAPI int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 260 */ -EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...); +TCLAPI int Tcl_VarEval(Tcl_Interp *interp, ...); /* 261 */ -EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, +TCLAPI ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ -EXTERN ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, +TCLAPI ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 263 */ -EXTERN int Tcl_Write(Tcl_Channel chan, const char *s, int slen); +TCLAPI int Tcl_Write(Tcl_Channel chan, const char *s, int slen); /* 264 */ -EXTERN void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, +TCLAPI void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 265 */ -EXTERN int Tcl_DumpActiveMemory(const char *fileName); +TCLAPI int Tcl_DumpActiveMemory(const char *fileName); /* 266 */ -EXTERN void Tcl_ValidateAllMemory(const char *file, int line); +TCLAPI void Tcl_ValidateAllMemory(const char *file, int line); /* 267 */ -EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp, +TCLAPI void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList); /* 268 */ -EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList); /* 269 */ -EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); +TCLAPI char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ -EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, - const char *start, CONST84 char **termPtr); +TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr); /* 271 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +TCLAPI const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 272 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, +TCLAPI const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 273 */ -EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, +TCLAPI int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, const char *version); /* 274 */ -EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +TCLAPI const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 275 */ -EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp, +TCLAPI void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList); /* 276 */ -EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); +TCLAPI int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList); /* 277 */ -EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); +TCLAPI Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options); /* 278 */ -EXTERN void Tcl_PanicVA(const char *format, va_list argList); +TCLAPI void Tcl_PanicVA(const char *format, va_list argList); /* 279 */ -EXTERN void Tcl_GetVersion(int *major, int *minor, +TCLAPI void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type); /* 280 */ -EXTERN void Tcl_InitMemory(Tcl_Interp *interp); +TCLAPI void Tcl_InitMemory(Tcl_Interp *interp); /* 281 */ -EXTERN Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 282 */ -EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, +TCLAPI int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 283 */ -EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); +TCLAPI Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); /* 284 */ -EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); +TCLAPI void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); /* Slot 285 is reserved */ /* 286 */ -EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 287 */ -EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); +TCLAPI Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ -EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 289 */ -EXTERN void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, +TCLAPI void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData); /* 290 */ -EXTERN void Tcl_DiscardResult(Tcl_SavedResult *statePtr); +TCLAPI void Tcl_DiscardResult(Tcl_SavedResult *statePtr); /* 291 */ -EXTERN int Tcl_EvalEx(Tcl_Interp *interp, const char *script, +TCLAPI int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 292 */ -EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc, +TCLAPI int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 293 */ -EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 294 */ -EXTERN void Tcl_ExitThread(int status); +TCLAPI void Tcl_ExitThread(int status); /* 295 */ -EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp, +TCLAPI int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 296 */ -EXTERN char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, +TCLAPI char * Tcl_ExternalToUtfDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 297 */ -EXTERN void Tcl_FinalizeThread(void); +TCLAPI void Tcl_FinalizeThread(void); /* 298 */ -EXTERN void Tcl_FinalizeNotifier(ClientData clientData); +TCLAPI void Tcl_FinalizeNotifier(ClientData clientData); /* 299 */ -EXTERN void Tcl_FreeEncoding(Tcl_Encoding encoding); +TCLAPI void Tcl_FreeEncoding(Tcl_Encoding encoding); /* 300 */ -EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); +TCLAPI Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ -EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); +TCLAPI Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); /* 302 */ -EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding); +TCLAPI const char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ -EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); +TCLAPI void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ -EXTERN int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, +TCLAPI int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 305 */ -EXTERN void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, +TCLAPI void * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size); /* 306 */ -EXTERN Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, +TCLAPI Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 307 */ -EXTERN ClientData Tcl_InitNotifier(void); +TCLAPI ClientData Tcl_InitNotifier(void); /* 308 */ -EXTERN void Tcl_MutexLock(Tcl_Mutex *mutexPtr); +TCLAPI void Tcl_MutexLock(Tcl_Mutex *mutexPtr); /* 309 */ -EXTERN void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr); +TCLAPI void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr); /* 310 */ -EXTERN void Tcl_ConditionNotify(Tcl_Condition *condPtr); +TCLAPI void Tcl_ConditionNotify(Tcl_Condition *condPtr); /* 311 */ -EXTERN void Tcl_ConditionWait(Tcl_Condition *condPtr, +TCLAPI void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 312 */ -EXTERN int Tcl_NumUtfChars(const char *src, int length); +TCLAPI int Tcl_NumUtfChars(const char *src, int length); /* 313 */ -EXTERN int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, +TCLAPI int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 314 */ -EXTERN void Tcl_RestoreResult(Tcl_Interp *interp, +TCLAPI void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ -EXTERN void Tcl_SaveResult(Tcl_Interp *interp, +TCLAPI void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 316 */ -EXTERN int Tcl_SetSystemEncoding(Tcl_Interp *interp, +TCLAPI int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name); /* 317 */ -EXTERN Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, +TCLAPI Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 318 */ -EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId); +TCLAPI void Tcl_ThreadAlert(Tcl_ThreadId threadId); /* 319 */ -EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, +TCLAPI void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 320 */ -EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); +TCLAPI Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index); /* 321 */ -EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch); +TCLAPI Tcl_UniChar Tcl_UniCharToLower(int ch); /* 322 */ -EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch); +TCLAPI Tcl_UniChar Tcl_UniCharToTitle(int ch); /* 323 */ -EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); +TCLAPI Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ -EXTERN int Tcl_UniCharToUtf(int ch, char *buf); +TCLAPI int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index); +TCLAPI const char * Tcl_UtfAtIndex(const char *src, int index); /* 326 */ -EXTERN int Tcl_UtfCharComplete(const char *src, int length); +TCLAPI int Tcl_UtfCharComplete(const char *src, int length); /* 327 */ -EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, +TCLAPI int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ -EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch); +TCLAPI const char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ -EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch); +TCLAPI const char * Tcl_UtfFindLast(const char *src, int ch); /* 330 */ -EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src); +TCLAPI const char * Tcl_UtfNext(const char *src); /* 331 */ -EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start); +TCLAPI const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ -EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, +TCLAPI int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 333 */ -EXTERN char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, +TCLAPI char * Tcl_UtfToExternalDString(Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 334 */ -EXTERN int Tcl_UtfToLower(char *src); +TCLAPI int Tcl_UtfToLower(char *src); /* 335 */ -EXTERN int Tcl_UtfToTitle(char *src); +TCLAPI int Tcl_UtfToTitle(char *src); /* 336 */ -EXTERN int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); +TCLAPI int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr); /* 337 */ -EXTERN int Tcl_UtfToUpper(char *src); +TCLAPI int Tcl_UtfToUpper(char *src); /* 338 */ -EXTERN int Tcl_WriteChars(Tcl_Channel chan, const char *src, +TCLAPI int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen); /* 339 */ -EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); +TCLAPI int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); /* 340 */ -EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); -/* 341 */ -EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); -/* 342 */ -EXTERN void Tcl_SetDefaultEncodingDir(const char *path); +TCLAPI char * Tcl_GetString(Tcl_Obj *objPtr); +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ /* 343 */ -EXTERN void Tcl_AlertNotifier(ClientData clientData); +TCLAPI void Tcl_AlertNotifier(ClientData clientData); /* 344 */ -EXTERN void Tcl_ServiceModeHook(int mode); +TCLAPI void Tcl_ServiceModeHook(int mode); /* 345 */ -EXTERN int Tcl_UniCharIsAlnum(int ch); +TCLAPI int Tcl_UniCharIsAlnum(int ch); /* 346 */ -EXTERN int Tcl_UniCharIsAlpha(int ch); +TCLAPI int Tcl_UniCharIsAlpha(int ch); /* 347 */ -EXTERN int Tcl_UniCharIsDigit(int ch); +TCLAPI int Tcl_UniCharIsDigit(int ch); /* 348 */ -EXTERN int Tcl_UniCharIsLower(int ch); +TCLAPI int Tcl_UniCharIsLower(int ch); /* 349 */ -EXTERN int Tcl_UniCharIsSpace(int ch); +TCLAPI int Tcl_UniCharIsSpace(int ch); /* 350 */ -EXTERN int Tcl_UniCharIsUpper(int ch); +TCLAPI int Tcl_UniCharIsUpper(int ch); /* 351 */ -EXTERN int Tcl_UniCharIsWordChar(int ch); +TCLAPI int Tcl_UniCharIsWordChar(int ch); /* 352 */ -EXTERN int Tcl_UniCharLen(const Tcl_UniChar *uniStr); +TCLAPI int Tcl_UniCharLen(const Tcl_UniChar *uniStr); /* 353 */ -EXTERN int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, +TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 354 */ -EXTERN char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, +TCLAPI char * Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 355 */ -EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, +TCLAPI Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, Tcl_DString *dsPtr); /* 356 */ -EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, +TCLAPI Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); -/* 357 */ -EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, - Tcl_Token *tokenPtr, int count); +/* Slot 357 is reserved */ /* 358 */ -EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr); +TCLAPI void Tcl_FreeParse(Tcl_Parse *parsePtr); /* 359 */ -EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, +TCLAPI void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, int length); /* 360 */ -EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, +TCLAPI int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr); + const char **termPtr); /* 361 */ -EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, +TCLAPI int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 362 */ -EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, +TCLAPI int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 363 */ -EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, +TCLAPI int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr); + const char **termPtr); /* 364 */ -EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, +TCLAPI int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 365 */ -EXTERN char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); +TCLAPI char * Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 366 */ -EXTERN int Tcl_Chdir(const char *dirName); +TCLAPI int Tcl_Chdir(const char *dirName); /* 367 */ -EXTERN int Tcl_Access(const char *path, int mode); +TCLAPI int Tcl_Access(const char *path, int mode); /* 368 */ -EXTERN int Tcl_Stat(const char *path, struct stat *bufPtr); +TCLAPI int Tcl_Stat(const char *path, struct stat *bufPtr); /* 369 */ -EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, +TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n); /* 370 */ -EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, +TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n); /* 371 */ -EXTERN int Tcl_StringCaseMatch(const char *str, +TCLAPI int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase); /* 372 */ -EXTERN int Tcl_UniCharIsControl(int ch); +TCLAPI int Tcl_UniCharIsControl(int ch); /* 373 */ -EXTERN int Tcl_UniCharIsGraph(int ch); +TCLAPI int Tcl_UniCharIsGraph(int ch); /* 374 */ -EXTERN int Tcl_UniCharIsPrint(int ch); +TCLAPI int Tcl_UniCharIsPrint(int ch); /* 375 */ -EXTERN int Tcl_UniCharIsPunct(int ch); +TCLAPI int Tcl_UniCharIsPunct(int ch); /* 376 */ -EXTERN int Tcl_RegExpExecObj(Tcl_Interp *interp, +TCLAPI int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 377 */ -EXTERN void Tcl_RegExpGetInfo(Tcl_RegExp regexp, +TCLAPI void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 378 */ -EXTERN Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, +TCLAPI Tcl_Obj * Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars); /* 379 */ -EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 380 */ -EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr); +TCLAPI int Tcl_GetCharLength(Tcl_Obj *objPtr); /* 381 */ -EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index); +TCLAPI Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index); /* 382 */ -EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); +TCLAPI Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr); /* 383 */ -EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); +TCLAPI Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last); /* 384 */ -EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 385 */ -EXTERN int Tcl_RegExpMatchObj(Tcl_Interp *interp, +TCLAPI int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 386 */ -EXTERN void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); +TCLAPI void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr); /* 387 */ -EXTERN Tcl_Mutex * Tcl_GetAllocMutex(void); +TCLAPI Tcl_Mutex * Tcl_GetAllocMutex(void); /* 388 */ -EXTERN int Tcl_GetChannelNames(Tcl_Interp *interp); +TCLAPI int Tcl_GetChannelNames(Tcl_Interp *interp); /* 389 */ -EXTERN int Tcl_GetChannelNamesEx(Tcl_Interp *interp, +TCLAPI int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern); /* 390 */ -EXTERN int Tcl_ProcObjCmd(ClientData clientData, +TCLAPI int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 391 */ -EXTERN void Tcl_ConditionFinalize(Tcl_Condition *condPtr); +TCLAPI void Tcl_ConditionFinalize(Tcl_Condition *condPtr); /* 392 */ -EXTERN void Tcl_MutexFinalize(Tcl_Mutex *mutex); +TCLAPI void Tcl_MutexFinalize(Tcl_Mutex *mutex); /* 393 */ -EXTERN int Tcl_CreateThread(Tcl_ThreadId *idPtr, +TCLAPI int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); /* 394 */ -EXTERN int Tcl_ReadRaw(Tcl_Channel chan, char *dst, +TCLAPI int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead); /* 395 */ -EXTERN int Tcl_WriteRaw(Tcl_Channel chan, const char *src, +TCLAPI int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen); /* 396 */ -EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); +TCLAPI Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ -EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); +TCLAPI int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ -EXTERN CONST84_RETURN char * Tcl_ChannelName( - const Tcl_ChannelType *chanTypePtr); +TCLAPI const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr); /* 399 */ -EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion( +TCLAPI Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr); /* 400 */ -EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( +TCLAPI Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc( const Tcl_ChannelType *chanTypePtr); /* 401 */ -EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc( +TCLAPI Tcl_DriverCloseProc * Tcl_ChannelCloseProc( const Tcl_ChannelType *chanTypePtr); /* 402 */ -EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( +TCLAPI Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc( const Tcl_ChannelType *chanTypePtr); /* 403 */ -EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc( +TCLAPI Tcl_DriverInputProc * Tcl_ChannelInputProc( const Tcl_ChannelType *chanTypePtr); /* 404 */ -EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc( +TCLAPI Tcl_DriverOutputProc * Tcl_ChannelOutputProc( const Tcl_ChannelType *chanTypePtr); /* 405 */ -EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc( +TCLAPI Tcl_DriverSeekProc * Tcl_ChannelSeekProc( const Tcl_ChannelType *chanTypePtr); /* 406 */ -EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( +TCLAPI Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 407 */ -EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc( +TCLAPI Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc( const Tcl_ChannelType *chanTypePtr); /* 408 */ -EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc( +TCLAPI Tcl_DriverWatchProc * Tcl_ChannelWatchProc( const Tcl_ChannelType *chanTypePtr); /* 409 */ -EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc( +TCLAPI Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc( const Tcl_ChannelType *chanTypePtr); /* 410 */ -EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc( +TCLAPI Tcl_DriverFlushProc * Tcl_ChannelFlushProc( const Tcl_ChannelType *chanTypePtr); /* 411 */ -EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( +TCLAPI Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc( const Tcl_ChannelType *chanTypePtr); /* 412 */ -EXTERN int Tcl_JoinThread(Tcl_ThreadId threadId, int *result); +TCLAPI int Tcl_JoinThread(Tcl_ThreadId threadId, int *result); /* 413 */ -EXTERN int Tcl_IsChannelShared(Tcl_Channel channel); +TCLAPI int Tcl_IsChannelShared(Tcl_Channel channel); /* 414 */ -EXTERN int Tcl_IsChannelRegistered(Tcl_Interp *interp, +TCLAPI int Tcl_IsChannelRegistered(Tcl_Interp *interp, Tcl_Channel channel); /* 415 */ -EXTERN void Tcl_CutChannel(Tcl_Channel channel); +TCLAPI void Tcl_CutChannel(Tcl_Channel channel); /* 416 */ -EXTERN void Tcl_SpliceChannel(Tcl_Channel channel); +TCLAPI void Tcl_SpliceChannel(Tcl_Channel channel); /* 417 */ -EXTERN void Tcl_ClearChannelHandlers(Tcl_Channel channel); +TCLAPI void Tcl_ClearChannelHandlers(Tcl_Channel channel); /* 418 */ -EXTERN int Tcl_IsChannelExisting(const char *channelName); +TCLAPI int Tcl_IsChannelExisting(const char *channelName); /* 419 */ -EXTERN int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, +TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 420 */ -EXTERN int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, +TCLAPI int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 421 */ -EXTERN Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, +TCLAPI Tcl_HashEntry * Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key); /* 422 */ -EXTERN Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, +TCLAPI Tcl_HashEntry * Tcl_CreateHashEntry(Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 423 */ -EXTERN void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, +TCLAPI void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 424 */ -EXTERN void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); +TCLAPI void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr); /* 425 */ -EXTERN ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, +TCLAPI ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 426 */ -EXTERN int Tcl_TraceCommand(Tcl_Interp *interp, +TCLAPI int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */ -EXTERN void Tcl_UntraceCommand(Tcl_Interp *interp, +TCLAPI void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 428 */ -EXTERN char * Tcl_AttemptAlloc(unsigned int size); +TCLAPI char * Tcl_AttemptAlloc(unsigned int size); /* 429 */ -EXTERN char * Tcl_AttemptDbCkalloc(unsigned int size, +TCLAPI char * Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line); /* 430 */ -EXTERN char * Tcl_AttemptRealloc(char *ptr, unsigned int size); +TCLAPI char * Tcl_AttemptRealloc(char *ptr, unsigned int size); /* 431 */ -EXTERN char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, +TCLAPI char * Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size, const char *file, int line); /* 432 */ -EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); +TCLAPI int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length); /* 433 */ -EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); +TCLAPI Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ -EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, +TCLAPI Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); -/* 435 */ -EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp, - const char *name, int *numArgsPtr, - Tcl_ValueType **argTypesPtr, - Tcl_MathProc **procPtr, - ClientData *clientDataPtr); -/* 436 */ -EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, - const char *pattern); +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ /* 437 */ -EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 438 */ -EXTERN int Tcl_DetachChannel(Tcl_Interp *interp, +TCLAPI int Tcl_DetachChannel(Tcl_Interp *interp, Tcl_Channel channel); /* 439 */ -EXTERN int Tcl_IsStandardChannel(Tcl_Channel channel); +TCLAPI int Tcl_IsStandardChannel(Tcl_Channel channel); /* 440 */ -EXTERN int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, +TCLAPI int Tcl_FSCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 441 */ -EXTERN int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, +TCLAPI int Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 442 */ -EXTERN int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); +TCLAPI int Tcl_FSCreateDirectory(Tcl_Obj *pathPtr); /* 443 */ -EXTERN int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); +TCLAPI int Tcl_FSDeleteFile(Tcl_Obj *pathPtr); /* 444 */ -EXTERN int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, +TCLAPI int Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 445 */ -EXTERN int Tcl_FSMatchInDirectory(Tcl_Interp *interp, +TCLAPI int Tcl_FSMatchInDirectory(Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 446 */ -EXTERN Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, +TCLAPI Tcl_Obj * Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 447 */ -EXTERN int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, +TCLAPI int Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 448 */ -EXTERN int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, +TCLAPI int Tcl_FSRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 449 */ -EXTERN int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +TCLAPI int Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 450 */ -EXTERN int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); +TCLAPI int Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval); /* 451 */ -EXTERN int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, +TCLAPI int Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 452 */ -EXTERN int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, +TCLAPI int Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 453 */ -EXTERN const char *CONST86 * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, +TCLAPI const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 454 */ -EXTERN int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +TCLAPI int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 455 */ -EXTERN int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode); +TCLAPI int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode); /* 456 */ -EXTERN Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel Tcl_FSOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 457 */ -EXTERN Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp); +TCLAPI Tcl_Obj * Tcl_FSGetCwd(Tcl_Interp *interp); /* 458 */ -EXTERN int Tcl_FSChdir(Tcl_Obj *pathPtr); +TCLAPI int Tcl_FSChdir(Tcl_Obj *pathPtr); /* 459 */ -EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, +TCLAPI int Tcl_FSConvertToPathType(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 460 */ -EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements); +TCLAPI Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, int elements); /* 461 */ -EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); +TCLAPI Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); /* 462 */ -EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, +TCLAPI int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 463 */ -EXTERN Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 464 */ -EXTERN Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, +TCLAPI Tcl_Obj * Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 465 */ -EXTERN ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, +TCLAPI ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 466 */ -EXTERN Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 467 */ -EXTERN int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); +TCLAPI int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName); /* 468 */ -EXTERN Tcl_Obj * Tcl_FSNewNativePath( +TCLAPI Tcl_Obj * Tcl_FSNewNativePath( const Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 469 */ -EXTERN const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); +TCLAPI const void * Tcl_FSGetNativePath(Tcl_Obj *pathPtr); /* 470 */ -EXTERN Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr); +TCLAPI Tcl_Obj * Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr); /* 471 */ -EXTERN Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); +TCLAPI Tcl_Obj * Tcl_FSPathSeparator(Tcl_Obj *pathPtr); /* 472 */ -EXTERN Tcl_Obj * Tcl_FSListVolumes(void); +TCLAPI Tcl_Obj * Tcl_FSListVolumes(void); /* 473 */ -EXTERN int Tcl_FSRegister(ClientData clientData, +TCLAPI int Tcl_FSRegister(ClientData clientData, const Tcl_Filesystem *fsPtr); /* 474 */ -EXTERN int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); +TCLAPI int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr); /* 475 */ -EXTERN ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); +TCLAPI ClientData Tcl_FSData(const Tcl_Filesystem *fsPtr); /* 476 */ -EXTERN const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, +TCLAPI const char * Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 477 */ -EXTERN CONST86 Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); +TCLAPI const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr); /* 478 */ -EXTERN Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); +TCLAPI Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr); /* 479 */ -EXTERN int Tcl_OutputBuffered(Tcl_Channel chan); +TCLAPI int Tcl_OutputBuffered(Tcl_Channel chan); /* 480 */ -EXTERN void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); +TCLAPI void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr); /* 481 */ -EXTERN int Tcl_EvalTokensStandard(Tcl_Interp *interp, +TCLAPI int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 482 */ -EXTERN void Tcl_GetTime(Tcl_Time *timeBuf); +TCLAPI void Tcl_GetTime(Tcl_Time *timeBuf); /* 483 */ -EXTERN Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, +TCLAPI Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 484 */ -EXTERN int Tcl_GetCommandInfoFromToken(Tcl_Command token, +TCLAPI int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 485 */ -EXTERN int Tcl_SetCommandInfoFromToken(Tcl_Command token, +TCLAPI int Tcl_SetCommandInfoFromToken(Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 486 */ -EXTERN Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, +TCLAPI Tcl_Obj * Tcl_DbNewWideIntObj(Tcl_WideInt wideValue, const char *file, int line); /* 487 */ -EXTERN int Tcl_GetWideIntFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 488 */ -EXTERN Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); +TCLAPI Tcl_Obj * Tcl_NewWideIntObj(Tcl_WideInt wideValue); /* 489 */ -EXTERN void Tcl_SetWideIntObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_SetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 490 */ -EXTERN Tcl_StatBuf * Tcl_AllocStatBuf(void); +TCLAPI Tcl_StatBuf * Tcl_AllocStatBuf(void); /* 491 */ -EXTERN Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, +TCLAPI Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 492 */ -EXTERN Tcl_WideInt Tcl_Tell(Tcl_Channel chan); +TCLAPI Tcl_WideInt Tcl_Tell(Tcl_Channel chan); /* 493 */ -EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( +TCLAPI Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc( const Tcl_ChannelType *chanTypePtr); /* 494 */ -EXTERN int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, +TCLAPI int Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 495 */ -EXTERN int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, +TCLAPI int Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 496 */ -EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ -EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, +TCLAPI int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 498 */ -EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ -EXTERN void Tcl_DictObjNext(Tcl_DictSearch *searchPtr, +TCLAPI void Tcl_DictObjNext(Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 500 */ -EXTERN void Tcl_DictObjDone(Tcl_DictSearch *searchPtr); +TCLAPI void Tcl_DictObjDone(Tcl_DictSearch *searchPtr); /* 501 */ -EXTERN int Tcl_DictObjPutKeyList(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjPutKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 502 */ -EXTERN int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, +TCLAPI int Tcl_DictObjRemoveKeyList(Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 503 */ -EXTERN Tcl_Obj * Tcl_NewDictObj(void); +TCLAPI Tcl_Obj * Tcl_NewDictObj(void); /* 504 */ -EXTERN Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line); +TCLAPI Tcl_Obj * Tcl_DbNewDictObj(const char *file, int line); /* 505 */ -EXTERN void Tcl_RegisterConfig(Tcl_Interp *interp, +TCLAPI void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 506 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 507 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); +TCLAPI void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 508 */ -EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, +TCLAPI int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 509 */ -EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 510 */ -EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 511 */ -EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, +TCLAPI int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 512 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); /* 513 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); /* 514 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */ -EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +TCLAPI Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 516 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 517 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, +TCLAPI void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 518 */ -EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, +TCLAPI int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 519 */ -EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); +TCLAPI Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); /* 520 */ -EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, +TCLAPI void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 521 */ -EXTERN void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, +TCLAPI void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 522 */ -EXTERN int Tcl_LimitReady(Tcl_Interp *interp); +TCLAPI int Tcl_LimitReady(Tcl_Interp *interp); /* 523 */ -EXTERN int Tcl_LimitCheck(Tcl_Interp *interp); +TCLAPI int Tcl_LimitCheck(Tcl_Interp *interp); /* 524 */ -EXTERN int Tcl_LimitExceeded(Tcl_Interp *interp); +TCLAPI int Tcl_LimitExceeded(Tcl_Interp *interp); /* 525 */ -EXTERN void Tcl_LimitSetCommands(Tcl_Interp *interp, +TCLAPI void Tcl_LimitSetCommands(Tcl_Interp *interp, int commandLimit); /* 526 */ -EXTERN void Tcl_LimitSetTime(Tcl_Interp *interp, +TCLAPI void Tcl_LimitSetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 527 */ -EXTERN void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, +TCLAPI void Tcl_LimitSetGranularity(Tcl_Interp *interp, int type, int granularity); /* 528 */ -EXTERN int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type); +TCLAPI int Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type); /* 529 */ -EXTERN int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type); +TCLAPI int Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type); /* 530 */ -EXTERN void Tcl_LimitTypeSet(Tcl_Interp *interp, int type); +TCLAPI void Tcl_LimitTypeSet(Tcl_Interp *interp, int type); /* 531 */ -EXTERN void Tcl_LimitTypeReset(Tcl_Interp *interp, int type); +TCLAPI void Tcl_LimitTypeReset(Tcl_Interp *interp, int type); /* 532 */ -EXTERN int Tcl_LimitGetCommands(Tcl_Interp *interp); +TCLAPI int Tcl_LimitGetCommands(Tcl_Interp *interp); /* 533 */ -EXTERN void Tcl_LimitGetTime(Tcl_Interp *interp, +TCLAPI void Tcl_LimitGetTime(Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 534 */ -EXTERN int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type); +TCLAPI int Tcl_LimitGetGranularity(Tcl_Interp *interp, int type); /* 535 */ -EXTERN Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status); +TCLAPI Tcl_InterpState Tcl_SaveInterpState(Tcl_Interp *interp, int status); /* 536 */ -EXTERN int Tcl_RestoreInterpState(Tcl_Interp *interp, +TCLAPI int Tcl_RestoreInterpState(Tcl_Interp *interp, Tcl_InterpState state); /* 537 */ -EXTERN void Tcl_DiscardInterpState(Tcl_InterpState state); +TCLAPI void Tcl_DiscardInterpState(Tcl_InterpState state); /* 538 */ -EXTERN int Tcl_SetReturnOptions(Tcl_Interp *interp, +TCLAPI int Tcl_SetReturnOptions(Tcl_Interp *interp, Tcl_Obj *options); /* 539 */ -EXTERN Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result); +TCLAPI Tcl_Obj * Tcl_GetReturnOptions(Tcl_Interp *interp, int result); /* 540 */ -EXTERN int Tcl_IsEnsemble(Tcl_Command token); +TCLAPI int Tcl_IsEnsemble(Tcl_Command token); /* 541 */ -EXTERN Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_CreateEnsemble(Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags); /* 542 */ -EXTERN Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_FindEnsemble(Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 543 */ -EXTERN int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 544 */ -EXTERN int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 545 */ -EXTERN int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 546 */ -EXTERN int Tcl_SetEnsembleFlags(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int flags); /* 547 */ -EXTERN int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 548 */ -EXTERN int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleMappingDict(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 549 */ -EXTERN int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 550 */ -EXTERN int Tcl_GetEnsembleFlags(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleFlags(Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 551 */ -EXTERN int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleNamespace(Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 552 */ -EXTERN void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, +TCLAPI void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 553 */ -EXTERN void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, +TCLAPI void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 554 */ -EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( +TCLAPI Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc( const Tcl_ChannelType *chanTypePtr); /* 555 */ -EXTERN Tcl_Obj * Tcl_NewBignumObj(mp_int *value); +TCLAPI Tcl_Obj * Tcl_NewBignumObj(mp_int *value); /* 556 */ -EXTERN Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file, +TCLAPI Tcl_Obj * Tcl_DbNewBignumObj(mp_int *value, const char *file, int line); /* 557 */ -EXTERN void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value); +TCLAPI void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value); /* 558 */ -EXTERN int Tcl_GetBignumFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */ -EXTERN int Tcl_TakeBignumFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 560 */ -EXTERN int Tcl_TruncateChannel(Tcl_Channel chan, +TCLAPI int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length); /* 561 */ -EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( +TCLAPI Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc( const Tcl_ChannelType *chanTypePtr); /* 562 */ -EXTERN void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, +TCLAPI void Tcl_SetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj *msg); /* 563 */ -EXTERN void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, +TCLAPI void Tcl_GetChannelErrorInterp(Tcl_Interp *interp, Tcl_Obj **msg); /* 564 */ -EXTERN void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); +TCLAPI void Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg); /* 565 */ -EXTERN void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); +TCLAPI void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg); /* 566 */ -EXTERN int Tcl_InitBignumFromDouble(Tcl_Interp *interp, +TCLAPI int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval, mp_int *toInit); /* 567 */ -EXTERN Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 568 */ -EXTERN int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, +TCLAPI int Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 569 */ -EXTERN int Tcl_GetEncodingFromObj(Tcl_Interp *interp, +TCLAPI int Tcl_GetEncodingFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 570 */ -EXTERN Tcl_Obj * Tcl_GetEncodingSearchPath(void); +TCLAPI Tcl_Obj * Tcl_GetEncodingSearchPath(void); /* 571 */ -EXTERN int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath); +TCLAPI int Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath); /* 572 */ -EXTERN const char * Tcl_GetEncodingNameFromEnvironment( +TCLAPI const char * Tcl_GetEncodingNameFromEnvironment( Tcl_DString *bufPtr); /* 573 */ -EXTERN int Tcl_PkgRequireProc(Tcl_Interp *interp, +TCLAPI int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 574 */ -EXTERN void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, +TCLAPI void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 575 */ -EXTERN void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length, int limit, const char *ellipsis); /* 576 */ -EXTERN Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, +TCLAPI Tcl_Obj * Tcl_Format(Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */ -EXTERN int Tcl_AppendFormatToObj(Tcl_Interp *interp, +TCLAPI int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 578 */ -EXTERN Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); +TCLAPI Tcl_Obj * Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 579 */ -EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, +TCLAPI void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 580 */ -EXTERN int Tcl_CancelEval(Tcl_Interp *interp, +TCLAPI int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr, ClientData clientData, int flags); /* 581 */ -EXTERN int Tcl_Canceled(Tcl_Interp *interp, int flags); +TCLAPI int Tcl_Canceled(Tcl_Interp *interp, int flags); /* 582 */ -EXTERN int Tcl_CreatePipe(Tcl_Interp *interp, +TCLAPI int Tcl_CreatePipe(Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 583 */ -EXTERN Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 584 */ -EXTERN int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 585 */ -EXTERN int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, +TCLAPI int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 586 */ -EXTERN int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, +TCLAPI int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 587 */ -EXTERN void Tcl_NRAddCallback(Tcl_Interp *interp, +TCLAPI void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, ClientData data0, ClientData data1, ClientData data2, ClientData data3); /* 588 */ -EXTERN int Tcl_NRCallObjProc(Tcl_Interp *interp, +TCLAPI int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, ClientData clientData, int objc, Tcl_Obj *const objv[]); /* 589 */ -EXTERN unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr); /* 590 */ -EXTERN unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr); /* 591 */ -EXTERN unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr); /* 592 */ -EXTERN int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr); /* 593 */ -EXTERN int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr); /* 594 */ -EXTERN int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr); /* 595 */ -EXTERN int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr); /* 596 */ -EXTERN Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr); /* 597 */ -EXTERN Tcl_WideInt Tcl_GetModificationTimeFromStat( +TCLAPI Tcl_WideInt Tcl_GetModificationTimeFromStat( const Tcl_StatBuf *statPtr); /* 598 */ -EXTERN Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr); /* 599 */ -EXTERN Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr); /* 600 */ -EXTERN Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr); +TCLAPI Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr); /* 601 */ -EXTERN unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr); +TCLAPI unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr); /* 602 */ -EXTERN int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, +TCLAPI int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 603 */ -EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, +TCLAPI int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ -EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, +TCLAPI int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 605 */ -EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); +TCLAPI int Tcl_GetErrorLine(Tcl_Interp *interp); /* 606 */ -EXTERN void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum); +TCLAPI void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum); /* 607 */ -EXTERN void Tcl_TransferResult(Tcl_Interp *sourceInterp, +TCLAPI void Tcl_TransferResult(Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); /* 608 */ -EXTERN int Tcl_InterpActive(Tcl_Interp *interp); +TCLAPI int Tcl_InterpActive(Tcl_Interp *interp); /* 609 */ -EXTERN void Tcl_BackgroundException(Tcl_Interp *interp, int code); +TCLAPI void Tcl_BackgroundException(Tcl_Interp *interp, int code); /* 610 */ -EXTERN int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, +TCLAPI int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 611 */ -EXTERN int Tcl_ZlibInflate(Tcl_Interp *interp, int format, +TCLAPI int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data, int buffersize, Tcl_Obj *gzipHeaderDictObj); /* 612 */ -EXTERN unsigned int Tcl_ZlibCRC32(unsigned int crc, +TCLAPI unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf, int len); /* 613 */ -EXTERN unsigned int Tcl_ZlibAdler32(unsigned int adler, +TCLAPI unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf, int len); /* 614 */ -EXTERN int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, +TCLAPI int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 615 */ -EXTERN Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle); +TCLAPI Tcl_Obj * Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle); /* 616 */ -EXTERN int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle); /* 617 */ -EXTERN int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle); /* 618 */ -EXTERN int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, +TCLAPI int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 619 */ -EXTERN int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, +TCLAPI int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count); /* 620 */ -EXTERN int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle); /* 621 */ -EXTERN int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle); +TCLAPI int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle); /* 622 */ -EXTERN void Tcl_SetStartupScript(Tcl_Obj *path, +TCLAPI void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding); /* 623 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr); +TCLAPI Tcl_Obj * Tcl_GetStartupScript(const char **encodingPtr); /* 624 */ -EXTERN int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, +TCLAPI int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 625 */ -EXTERN int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 626 */ -EXTERN int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 627 */ -EXTERN int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, +TCLAPI int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 628 */ -EXTERN void * Tcl_FindSymbol(Tcl_Interp *interp, +TCLAPI void * Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 629 */ -EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp, +TCLAPI int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 630 */ -EXTERN void Tcl_ZlibStreamSetCompressionDictionary( +TCLAPI void Tcl_ZlibStreamSetCompressionDictionary( Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); @@ -1823,7 +1780,7 @@ typedef struct TclStubs { const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ - CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ + const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ char * (*tcl_Alloc) (unsigned int size); /* 3 */ void (*tcl_Free) (char *ptr); /* 4 */ @@ -1874,11 +1831,11 @@ typedef struct TclStubs { unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ - int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ + int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ - CONST86 Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ + const 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 */ @@ -1915,16 +1872,16 @@ typedef struct TclStubs { void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */ int (*tcl_AsyncReady) (void); /* 75 */ void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */ - char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */ + void (*reserved77)(void); int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */ void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */ void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */ int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */ int (*tcl_CommandComplete) (const char *cmd); /* 82 */ - char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */ + char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ - int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */ + int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */ void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */ @@ -1933,7 +1890,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 (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */ + void (*reserved95)(void); 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 */ @@ -1965,10 +1922,10 @@ typedef struct TclStubs { void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */ void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */ int (*tcl_Eof) (Tcl_Channel chan); /* 126 */ - CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */ - CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */ + const char * (*tcl_ErrnoId) (void); /* 127 */ + 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 (*reserved130)(void); int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ void (*tcl_Exit) (int status); /* 133 */ @@ -1982,25 +1939,25 @@ typedef struct TclStubs { int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ - void (*tcl_FindExecutable) (const char *argv0); /* 144 */ + void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ - int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */ - int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ + int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ + int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ - CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ + const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ - CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ + const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ - CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ + const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ - CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */ + const char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */ Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ @@ -2020,11 +1977,11 @@ typedef struct TclStubs { int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ - CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ - CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ - CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ - int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ - int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ + const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ + const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ + const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ + void (*reserved177)(void); + void (*reserved178)(void); 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 */ @@ -2032,25 +1989,25 @@ typedef struct TclStubs { int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */ int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */ int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */ - char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */ + char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */ void (*reserved188)(void); Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ - char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */ + char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */ Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */ - Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */ + Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ void (*tcl_Preserve) (ClientData data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ - CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ + const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ @@ -2061,12 +2018,12 @@ typedef struct TclStubs { Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ - void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */ + void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */ - int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */ + void (*reserved220)(void); 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 */ @@ -2083,16 +2040,16 @@ typedef struct TclStubs { void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ - CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ - CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */ - CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */ + const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ + const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ + const char * (*tcl_SignalId) (int sig); /* 239 */ + const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */ - void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */ + int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ + void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ 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 */ - int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ + void (*reserved246)(void); 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 */ @@ -2116,11 +2073,11 @@ typedef struct TclStubs { void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ - CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */ - CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ - CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ + 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 */ - CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ + const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ @@ -2148,7 +2105,7 @@ typedef struct TclStubs { void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ - CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ + const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ @@ -2171,13 +2128,13 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ + const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ - CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ - CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ - CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */ - CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ + const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ + const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ + const char * (*tcl_UtfNext) (const char *src); /* 330 */ + const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ @@ -2187,8 +2144,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 */ - CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */ - void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */ + void (*reserved341)(void); + void (*reserved342)(void); void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */ void (*tcl_ServiceModeHook) (int mode); /* 344 */ int (*tcl_UniCharIsAlnum) (int ch); /* 345 */ @@ -2203,13 +2160,13 @@ typedef struct TclStubs { char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */ Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */ Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */ - Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */ + void (*reserved357)(void); 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, CONST84 char **termPtr); /* 360 */ + int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */ int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */ int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */ - int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */ + int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ @@ -2244,7 +2201,7 @@ typedef struct TclStubs { int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ - CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ + const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ @@ -2281,8 +2238,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 */ - int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */ - Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */ + void (*reserved435)(void); + void (*reserved436)(void); 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 */ @@ -2299,7 +2256,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 *CONST86 * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */ + const char *const * (*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 */ @@ -2323,7 +2280,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 */ - CONST86 Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */ + const 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 */ @@ -2659,8 +2616,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_AsyncReady) /* 75 */ #define Tcl_BackgroundError \ (tclStubsPtr->tcl_BackgroundError) /* 76 */ -#define Tcl_Backslash \ - (tclStubsPtr->tcl_Backslash) /* 77 */ +/* Slot 77 is reserved */ #define Tcl_BadChannelOption \ (tclStubsPtr->tcl_BadChannelOption) /* 78 */ #define Tcl_CallWhenDeleted \ @@ -2695,8 +2651,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateExitHandler) /* 93 */ #define Tcl_CreateInterp \ (tclStubsPtr->tcl_CreateInterp) /* 94 */ -#define Tcl_CreateMathFunc \ - (tclStubsPtr->tcl_CreateMathFunc) /* 95 */ +/* Slot 95 is reserved */ #define Tcl_CreateObjCommand \ (tclStubsPtr->tcl_CreateObjCommand) /* 96 */ #define Tcl_CreateSlave \ @@ -2765,8 +2720,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ #define Tcl_Eval \ (tclStubsPtr->tcl_Eval) /* 129 */ -#define Tcl_EvalFile \ - (tclStubsPtr->tcl_EvalFile) /* 130 */ +/* Slot 130 is reserved */ #define Tcl_EvalObj \ (tclStubsPtr->tcl_EvalObj) /* 131 */ #define Tcl_EventuallyFree \ @@ -2793,8 +2747,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ExprString) /* 142 */ #define Tcl_Finalize \ (tclStubsPtr->tcl_Finalize) /* 143 */ -#define Tcl_FindExecutable \ - (tclStubsPtr->tcl_FindExecutable) /* 144 */ +/* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ @@ -2865,10 +2818,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetVar) /* 175 */ #define Tcl_GetVar2 \ (tclStubsPtr->tcl_GetVar2) /* 176 */ -#define Tcl_GlobalEval \ - (tclStubsPtr->tcl_GlobalEval) /* 177 */ -#define Tcl_GlobalEvalObj \ - (tclStubsPtr->tcl_GlobalEvalObj) /* 178 */ +/* Slot 177 is reserved */ +/* Slot 178 is reserved */ #define Tcl_HideCommand \ (tclStubsPtr->tcl_HideCommand) /* 179 */ #define Tcl_Init \ @@ -2950,8 +2901,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ScanElement) /* 218 */ #define Tcl_ScanCountedElement \ (tclStubsPtr->tcl_ScanCountedElement) /* 219 */ -#define Tcl_SeekOld \ - (tclStubsPtr->tcl_SeekOld) /* 220 */ +/* Slot 220 is reserved */ #define Tcl_ServiceAll \ (tclStubsPtr->tcl_ServiceAll) /* 221 */ #define Tcl_ServiceEvent \ @@ -3002,8 +2952,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_StaticPackage) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ +/* Slot 246 is reserved */ #define Tcl_TraceVar \ (tclStubsPtr->tcl_TraceVar) /* 247 */ #define Tcl_TraceVar2 \ @@ -3191,10 +3140,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_WriteObj) /* 339 */ #define Tcl_GetString \ (tclStubsPtr->tcl_GetString) /* 340 */ -#define Tcl_GetDefaultEncodingDir \ - (tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */ -#define Tcl_SetDefaultEncodingDir \ - (tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */ +/* Slot 341 is reserved */ +/* Slot 342 is reserved */ #define Tcl_AlertNotifier \ (tclStubsPtr->tcl_AlertNotifier) /* 343 */ #define Tcl_ServiceModeHook \ @@ -3223,8 +3170,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */ #define Tcl_GetRegExpFromObj \ (tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */ -#define Tcl_EvalTokens \ - (tclStubsPtr->tcl_EvalTokens) /* 357 */ +/* Slot 357 is reserved */ #define Tcl_FreeParse \ (tclStubsPtr->tcl_FreeParse) /* 358 */ #define Tcl_LogCommandInfo \ @@ -3379,10 +3325,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetChannelThread) /* 433 */ #define Tcl_GetUnicodeFromObj \ (tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */ -#define Tcl_GetMathFuncInfo \ - (tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */ -#define Tcl_ListMathFuncs \ - (tclStubsPtr->tcl_ListMathFuncs) /* 436 */ +/* Slot 435 is reserved */ +/* Slot 436 is reserved */ #define Tcl_SubstObj \ (tclStubsPtr->tcl_SubstObj) /* 437 */ #define Tcl_DetachChannel \ @@ -3782,27 +3726,24 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_GetStringResult # undef Tcl_Init # undef Tcl_SetPanicProc -# undef Tcl_SetVar +# undef Tcl_SetVar2 # undef Tcl_StaticPackage # undef TclFSGetNativePath # define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp()) # define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp)) # define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp)) # define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc)) -# define Tcl_SetVar(interp, varName, newValue, flags) \ - (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags)) +# define Tcl_SetVar2(interp, part1, part2, newValue, flags) \ + (tclStubsPtr->tcl_SetVar2(interp, part1, part2, newValue, flags)) #endif #if defined(_WIN32) && defined(UNICODE) # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) # define Tcl_MainEx Tcl_MainExW - EXTERN void Tcl_MainExW(int argc, wchar_t **argv, +TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - /* * Deprecated Tcl procedures: */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 7d2206b..5bde14e 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -673,68 +673,6 @@ TclFinalizeEncodingSubsystem(void) /* *------------------------------------------------------------------------- * - * 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. - * - *------------------------------------------------------------------------- - */ - -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 Tcl_GetString(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); -} - -/* - *------------------------------------------------------------------------- - * * Tcl_GetEncoding -- * * Given the name of a encoding, find the corresponding Tcl_Encoding diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index f392cad..efa6339 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -87,17 +87,6 @@ const Tcl_ObjType tclEnsembleCmdType = { StringOfEnsembleCmdRep, /* updateStringProc */ NULL /* setFromAnyProc */ }; - -/* - * Copied from tclCompCmds.c - */ - -#define DefineLineInformation \ - ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ - int eclIndex = mapPtr->nuloc - 1 -#define SetLineInformation(word) \ - envPtr->line = mapPtr->loc[eclIndex].line[(word)]; \ - envPtr->clNext = mapPtr->loc[eclIndex].next[(word)] static inline Tcl_Obj * NewNsObj( @@ -3198,8 +3187,7 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr); - TclEmitInt1(numWords+1, envPtr); + OP41( INVOKE_REPLACE, parsePtr->numWords, numWords+1); TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */ } @@ -3264,11 +3252,7 @@ CompileBasicNArgCommand( * Do the standard dispatch. */ - if (i <= 255) { - TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr); - } else { - TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr); - } + OP4( INVOKE_STK, i); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7d4f47a..d3bae38 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -107,63 +107,6 @@ 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 @@ -190,7 +133,7 @@ typedef struct TEBCdata { esPtr->tosPtr = tosPtr; \ TD->pc = pc; \ TD->cleanup = cleanup; \ - TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \ + TclNRAddCallback(interp, ExecuteByteCode, TD, INT2PTR(1),NULL,NULL); \ } while (0) #define TEBC_DATA_DIG() \ @@ -316,11 +259,11 @@ VarHashCreateVar( } while (0) /* - * Macros used to cache often-referenced Tcl evaluation stack information - * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() - * pair must surround any call inside TclNRExecuteByteCode (and a few other - * procedures that use this scheme) that could result in a recursive call - * to TclNRExecuteByteCode. + * Macros used to cache often-referenced Tcl evaluation stack information in + * local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() pair + * must surround any call inside ExecuteByteCode (and a few other procedures + * that use this scheme) that could result in a recursive call to + * ExecuteByteCode. */ #define CACHE_STACK_INFO() \ @@ -342,12 +285,19 @@ VarHashCreateVar( * WARNING! It is essential that objPtr only appear once in the PUSH_OBJECT * macro. The actual parameter might be an expression with side effects, and * this ensures that it will be executed only once. + * + * For actually discarding an object from the stack, use POP_DROP_OBJECT(). */ #define PUSH_OBJECT(objPtr) \ Tcl_IncrRefCount(*(++tosPtr) = (objPtr)) #define POP_OBJECT() *(tosPtr--) +#define POP_DROP_OBJECT() \ + do { \ + register Tcl_Obj *discardPtr = POP_OBJECT(); \ + TclDecrRefCount(discardPtr); \ + } while (0) #define OBJ_AT_TOS *tosPtr @@ -690,9 +640,7 @@ static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt); */ #ifdef TCL_COMPILE_STATS -static int EvalStatsCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc EvalStatsCmd; #endif /* TCL_COMPILE_STATS */ #ifdef TCL_COMPILE_DEBUG static const char * GetOpcodeName(const unsigned char *pc); @@ -731,8 +679,7 @@ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; - -static Tcl_NRPostProc TEBCresume; +static Tcl_NRPostProc ExecuteByteCode; /* * The structure below defines a bytecode Tcl object type to hold the @@ -2019,13 +1966,13 @@ TclNRExecuteByteCode( * Push the callback for bytecode execution */ - TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0), + TclNRAddCallback(interp, ExecuteByteCode, TD, /*resume*/ INT2PTR(0), NULL, NULL); return TCL_OK; } static int -TEBCresume( +ExecuteByteCode( ClientData data[], Tcl_Interp *interp, int result) @@ -2066,6 +2013,14 @@ TEBCresume( #define LOCAL(i) (&compiledLocals[(i)]) #define TCONST(i) (constants[(i)]) +#define LOCALVAR(varPtr,i) \ + do { \ + register Var *vPtr = LOCAL(i); \ + while (TclIsVarLink(vPtr)) { \ + vPtr = vPtr->value.linkPtr; \ + } \ + (varPtr) = vPtr; \ + } while (0) /* * These macros are just meant to save some global variables that are not @@ -2214,13 +2169,11 @@ TEBCresume( default: cleanup -= 2; while (cleanup--) { - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); } case 2: cleanup2_pushObjResultPtr: - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); case 1: cleanup1_pushObjResultPtr: objPtr = OBJ_AT_TOS; @@ -2234,17 +2187,14 @@ TEBCresume( default: cleanup -= 2; while (cleanup--) { - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); } case 2: cleanup2: - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); case 1: cleanup1: - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); case 0: /* * We really want to do nothing now, but this is needed for some @@ -2317,12 +2267,12 @@ TEBCresume( TCL_DTRACE_INST_NEXT(); - if (inst == INST_LOAD_SCALAR1) { - goto instLoadScalar1; - } else if (inst == INST_PUSH1) { - PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt1AtPtr(pc+1)]); - TRACE_WITH_OBJ(("%u => ", TclGetInt1AtPtr(pc+1)), OBJ_AT_TOS); - inst = *(pc += 2); + if (inst == INST_LOAD_SCALAR) { + goto instLoadScalar; + } else if (inst == INST_PUSH) { + PUSH_OBJECT(codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]); + TRACE_WITH_OBJ(("%u => ", TclGetInt4AtPtr(pc+1)), OBJ_AT_TOS); + inst = *(pc += 5); goto peepholeStart; } else if (inst == INST_START_CMD) { /* @@ -2492,15 +2442,9 @@ TEBCresume( (void) POP_OBJECT(); goto abnormalReturn; - case INST_PUSH4: - objResultPtr = codePtr->objArrayPtr[TclGetUInt4AtPtr(pc+1)]; - TRACE_WITH_OBJ(("%u => ", TclGetUInt4AtPtr(pc+1)), objResultPtr); - NEXT_INST_F(5, 0, 1); - case INST_POP: TRACE_WITH_OBJ(("=> discarding "), OBJ_AT_TOS); - objPtr = POP_OBJECT(); - TclDecrRefCount(objPtr); + POP_DROP_OBJECT(); NEXT_INST_F(1, 0, 0); case INST_NOP: @@ -2510,17 +2454,32 @@ TEBCresume( objResultPtr = OBJ_AT_TOS; TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); - + case INST_UNDER: + objResultPtr = OBJ_UNDER_TOS; + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(1, 0, 1); case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(5, 0, 1); - case INST_REVERSE: { + { Tcl_Obj **a, **b; + case INST_EXCH: + TRACE(("\"%.20s\" \"%.20s\" => ", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); + tmpPtr = OBJ_AT_TOS; + OBJ_AT_TOS = OBJ_UNDER_TOS; + OBJ_UNDER_TOS = tmpPtr; + TRACE_APPEND(("\"%.20s\" \"%.20s\"", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); + NEXT_INST_F(1, 0, 0); + + case INST_REVERSE: opnd = TclGetUInt4AtPtr(pc+1); + TRACE(("%u\n", opnd)); a = tosPtr-(opnd-1); b = tosPtr; while (a<b) { @@ -2532,7 +2491,7 @@ TEBCresume( NEXT_INST_F(5, 0, 0); } - case INST_CONCAT1: { + case INST_CONCAT: { int appendLen = 0; char *bytes, *p; Tcl_Obj **currPtr; @@ -2800,15 +2759,9 @@ TEBCresume( TclNewObj(objResultPtr); NEXT_INST_F(1, 0, 1); - case INST_INVOKE_STK4: + case INST_INVOKE_STK: objc = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; - goto doInvocation; - - case INST_INVOKE_STK1: - objc = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - doInvocation: objv = &OBJ_AT_DEPTH(objc-1); cleanup = objc; @@ -2855,91 +2808,6 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, 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); @@ -3013,35 +2881,10 @@ TEBCresume( * common execution code. */ - case INST_LOAD_SCALAR1: - instLoadScalar1: - opnd = TclGetUInt1AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } - TRACE(("%u => ", opnd)); - if (TclIsVarDirectReadable(varPtr)) { - /* - * No errors, no traces: just get the value. - */ - - objResultPtr = varPtr->value.objPtr; - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(2, 0, 1); - } - pcAdjustment = 2; - cleanup = 0; - arrayPtr = NULL; - part1Ptr = part2Ptr = NULL; - goto doCallPtrGetVar; - - case INST_LOAD_SCALAR4: + case INST_LOAD_SCALAR: + instLoadScalar: opnd = TclGetUInt4AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { /* @@ -3058,22 +2901,11 @@ TEBCresume( part1Ptr = part2Ptr = NULL; goto doCallPtrGetVar; - case INST_LOAD_ARRAY4: + case INST_LOAD_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); - pcAdjustment = 5; - goto doLoadArray; - - case INST_LOAD_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doLoadArray: part1Ptr = NULL; part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); @@ -3084,7 +2916,7 @@ TEBCresume( objResultPtr = varPtr->value.objPtr; TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(pcAdjustment, 1, 1); + NEXT_INST_F(5, 1, 1); } } varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, @@ -3094,6 +2926,7 @@ TEBCresume( goto gotError; } cleanup = 1; + pcAdjustment = 5; goto doCallPtrGetVar; case INST_LOAD_ARRAY_STK: @@ -3162,24 +2995,15 @@ TEBCresume( { int storeFlags; - case INST_STORE_ARRAY4: + case INST_STORE_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; - goto doStoreArrayDirect; - case INST_STORE_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doStoreArrayDirect: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; - arrayPtr = LOCAL(opnd); + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } if (TclIsVarArray(arrayPtr) && !WriteTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (varPtr && TclIsVarDirectWritable(varPtr)) { @@ -3194,22 +3018,13 @@ TEBCresume( part1Ptr = NULL; goto doStoreArrayDirectFailed; - case INST_STORE_SCALAR4: + case INST_STORE_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; - goto doStoreScalarDirect; - case INST_STORE_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - - doStoreScalarDirect: valuePtr = OBJ_AT_TOS; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } if (!TclIsVarDirectWritable(varPtr)) { storeFlags = TCL_LEAVE_ERR_MSG; part1Ptr = NULL; @@ -3300,41 +3115,24 @@ TEBCresume( opnd = -1; goto doCallPtrSetVar; - case INST_LAPPEND_ARRAY4: + case INST_LAPPEND_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreArray; - case INST_LAPPEND_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE - | TCL_LIST_ELEMENT); - goto doStoreArray; - - case INST_APPEND_ARRAY4: + case INST_APPEND_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); - goto doStoreArray; - - case INST_APPEND_ARRAY1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); - goto doStoreArray; doStoreArray: valuePtr = OBJ_AT_TOS; part2Ptr = OBJ_UNDER_TOS; - arrayPtr = LOCAL(opnd); + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" <- \"%.30s\" => ", opnd, O2S(part2Ptr), O2S(valuePtr))); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } cleanup = 2; part1Ptr = NULL; @@ -3347,39 +3145,22 @@ TEBCresume( } goto doCallPtrSetVar; - case INST_LAPPEND_SCALAR4: + case INST_LAPPEND_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE | TCL_LIST_ELEMENT); goto doStoreScalar; - case INST_LAPPEND_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE - | TCL_LIST_ELEMENT); - goto doStoreScalar; - - case INST_APPEND_SCALAR4: + case INST_APPEND_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); pcAdjustment = 5; storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); - goto doStoreScalar; - - case INST_APPEND_SCALAR1: - opnd = TclGetUInt1AtPtr(pc+1); - pcAdjustment = 2; - storeFlags = (TCL_LEAVE_ERR_MSG | TCL_APPEND_VALUE); - goto doStoreScalar; doStoreScalar: valuePtr = OBJ_AT_TOS; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); TRACE(("%u <- \"%.30s\" => ", opnd, O2S(valuePtr))); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } cleanup = 1; arrayPtr = NULL; part1Ptr = part2Ptr = NULL; @@ -3421,30 +3202,17 @@ TEBCresume( #endif long increment; - case INST_INCR_SCALAR1: - case INST_INCR_ARRAY1: case INST_INCR_ARRAY_STK: - case INST_INCR_SCALAR_STK: case INST_INCR_STK: - opnd = TclGetUInt1AtPtr(pc+1); + opnd = TclGetUInt4AtPtr(pc+1); incrPtr = POP_OBJECT(); - switch (*pc) { - case INST_INCR_SCALAR1: - pcAdjustment = 2; - goto doIncrScalar; - case INST_INCR_ARRAY1: - pcAdjustment = 2; - goto doIncrArray; - default: - pcAdjustment = 1; - goto doIncrStk; - } + pcAdjustment = 1; + goto doIncrStk; case INST_INCR_ARRAY_STK_IMM: - case INST_INCR_SCALAR_STK_IMM: case INST_INCR_STK_IMM: increment = TclGetInt1AtPtr(pc+1); - incrPtr = Tcl_NewIntObj(increment); + TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); pcAdjustment = 2; @@ -3474,21 +3242,23 @@ TEBCresume( cleanup = ((part2Ptr == NULL)? 1 : 2); goto doIncrVar; - case INST_INCR_ARRAY1_IMM: - opnd = TclGetUInt1AtPtr(pc+1); - increment = TclGetInt1AtPtr(pc+2); - incrPtr = Tcl_NewIntObj(increment); + case INST_INCR_ARRAY_IMM: + opnd = TclGetUInt4AtPtr(pc+1); + increment = TclGetInt1AtPtr(pc+5); + TclNewIntObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); - pcAdjustment = 3; + pcAdjustment = 6; + goto doIncrArray; + case INST_INCR_ARRAY: + opnd = TclGetUInt4AtPtr(pc+1); + incrPtr = POP_OBJECT(); + pcAdjustment = 5; doIncrArray: part1Ptr = NULL; part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); + LOCALVAR(arrayPtr, opnd); cleanup = 1; - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } TRACE(("%u \"%.30s\" (by %ld) => ", opnd, O2S(part2Ptr), increment)); varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd); @@ -3499,132 +3269,108 @@ TEBCresume( } goto doIncrVar; - case INST_INCR_SCALAR1_IMM: - opnd = TclGetUInt1AtPtr(pc+1); - increment = TclGetInt1AtPtr(pc+2); - pcAdjustment = 3; - cleanup = 0; - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + /* + * This is the most common type of INST_INCR_* as it is the one that + * [incr foo] (of a local variable) is compiled into, where 'foo' + * holds a small integer. Thus we take special effort to make sure + * that it goes faster than many other instructions. + */ + + case INST_INCR_SCALAR_IMM: + opnd = TclGetUInt4AtPtr(pc+1); + increment = TclGetInt1AtPtr(pc+5); + LOCALVAR(varPtr, opnd); if (TclIsVarDirectModifyable(varPtr)) { ClientData ptr; int type; objPtr = varPtr->value.objPtr; - if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { - if (type == TCL_NUMBER_LONG) { - long augend = *((const long *)ptr); - long sum = augend + increment; - - /* - * Overflow when (augend and sum have different sign) and - * (augend and increment have the same sign). This is - * encapsulated in the Overflowing macro. - */ + if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK + && type == TCL_NUMBER_LONG) { + long augend = *((const long *)ptr); + long sum = augend + increment; - if (!Overflowing(augend, increment, sum)) { - TRACE(("%u %ld => ", opnd, increment)); - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared. */ - TclNewLongObj(objResultPtr, sum); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - TclSetLongObj(objPtr, sum); - } - goto doneIncr; - } -#ifndef NO_WIDE_TYPE - w = (Tcl_WideInt)augend; + /* + * Overflow when (augend and sum have different sign) and + * (augend and increment have the same sign). This is + * encapsulated in the Overflowing macro. + */ + if (!Overflowing(augend, increment, sum)) { TRACE(("%u %ld => ", opnd, increment)); if (Tcl_IsShared(objPtr)) { objPtr->refCount--; /* We know it's shared. */ - objResultPtr = Tcl_NewWideIntObj(w+increment); + TclNewLongObj(objResultPtr, sum); Tcl_IncrRefCount(objResultPtr); varPtr->value.objPtr = objResultPtr; } else { objResultPtr = objPtr; + TclSetLongObj(objPtr, sum); + } + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); +#ifndef TCL_COMPILE_DEBUG + if (*(pc+6) == INST_POP) { + NEXT_INST_F(7, 0, 0); + } +#endif /*!TCL_COMPILE_DEBUG*/ + NEXT_INST_F(6, 0, 1); + } - /* - * We know the sum value is outside the long range; - * use macro form that doesn't range test again. - */ + /* + * If adding a byte to a long won't fit but we've got a + * functional wide integer type defined, we *know* that we'll + * be able to fit in that. (That is, long is 32 bits and wide + * is 64 bits, and our increment is only 8 bits.) + */ - TclSetWideIntObj(objPtr, w+increment); - } - goto doneIncr; -#endif - } /* end if (type == TCL_NUMBER_LONG) */ #ifndef NO_WIDE_TYPE - if (type == TCL_NUMBER_WIDE) { - Tcl_WideInt sum; - - w = *((const Tcl_WideInt *) ptr); - sum = w + increment; + w = (Tcl_WideInt)augend; + + TRACE(("%u %ld => ", opnd, increment)); + if (Tcl_IsShared(objPtr)) { + objPtr->refCount--; /* We know it's shared. */ + TclNewWideIntObj(objResultPtr, w+increment); + Tcl_IncrRefCount(objResultPtr); + varPtr->value.objPtr = objResultPtr; + } else { + objResultPtr = objPtr; /* - * Check for overflow. + * We know the sum value is outside the long range; use + * macro form that doesn't range test again. */ - if (!Overflowing(w, increment, sum)) { - TRACE(("%u %ld => ", opnd, increment)); - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared. */ - objResultPtr = Tcl_NewWideIntObj(sum); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - - /* - * We *do not* know the sum value is outside the - * long range (wide + long can yield long); use - * the function call that checks range. - */ - - Tcl_SetWideIntObj(objPtr, sum); - } - goto doneIncr; - } + TclSetWideIntObj(objPtr, w+increment); } -#endif - } - if (Tcl_IsShared(objPtr)) { - objPtr->refCount--; /* We know it's shared */ - objResultPtr = Tcl_DuplicateObj(objPtr); - Tcl_IncrRefCount(objResultPtr); - varPtr->value.objPtr = objResultPtr; - } else { - objResultPtr = objPtr; - } - TclNewLongObj(incrPtr, increment); - if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { - Tcl_DecrRefCount(incrPtr); - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); - goto gotError; + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); +#ifndef TCL_COMPILE_DEBUG + if (*(pc+6) == INST_POP) { + NEXT_INST_F(7, 0, 0); + } +#endif /*!TCL_COMPILE_DEBUG*/ + NEXT_INST_F(6, 0, 1); +#endif /*!NO_WIDE_TYPE*/ } - Tcl_DecrRefCount(incrPtr); - goto doneIncr; } /* - * All other cases, flow through to generic handling. + * All other cases, flow through to generic handling. Note that we've + * already followed the linked-var chain so we can skip that. */ TclNewLongObj(incrPtr, increment); Tcl_IncrRefCount(incrPtr); + pcAdjustment = 6; + cleanup = 0; + goto doIncrScalar; + case INST_INCR_SCALAR: + opnd = TclGetUInt4AtPtr(pc+1); + incrPtr = POP_OBJECT(); + pcAdjustment = 5; + LOCALVAR(varPtr, opnd); doIncrScalar: - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } arrayPtr = NULL; part1Ptr = part2Ptr = NULL; cleanup = 0; @@ -3660,7 +3406,6 @@ TEBCresume( goto gotError; } } - doneIncr: TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #ifndef TCL_COMPILE_DEBUG if (*(pc+pcAdjustment) == INST_POP) { @@ -3678,10 +3423,7 @@ TEBCresume( case INST_EXIST_SCALAR: opnd = TclGetUInt4AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%u => ", opnd)); if (ReadTraced(varPtr)) { DECACHE_STACK_INFO(); @@ -3705,10 +3447,7 @@ TEBCresume( case INST_EXIST_ARRAY: opnd = TclGetUInt4AtPtr(pc+1); part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } + LOCALVAR(arrayPtr, opnd); TRACE(("%u \"%.30s\" => ", opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); @@ -3779,10 +3518,7 @@ TEBCresume( case INST_UNSET_SCALAR: flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; opnd = TclGetUInt4AtPtr(pc+2); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd)); if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { /* @@ -3812,10 +3548,7 @@ TEBCresume( flags = TclGetUInt1AtPtr(pc+1) ? TCL_LEAVE_ERR_MSG : 0; opnd = TclGetUInt4AtPtr(pc+2); part2Ptr = OBJ_AT_TOS; - arrayPtr = LOCAL(opnd); - while (TclIsVarLink(arrayPtr)) { - arrayPtr = arrayPtr->value.linkPtr; - } + LOCALVAR(arrayPtr, opnd); TRACE(("%s %u \"%.30s\"\n", (flags ? "normal" : "noerr"), opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) { @@ -3885,29 +3618,6 @@ TEBCresume( CACHE_STACK_INFO(); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; - - /* - * This is really an unset operation these days. Do not issue. - */ - - case INST_DICT_DONE: - opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u\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(); - TclPtrUnsetVar(interp, varPtr, NULL, NULL, NULL, 0, opnd); - CACHE_STACK_INFO(); - } - NEXT_INST_F(5, 0, 0); } /* @@ -3923,10 +3633,7 @@ TEBCresume( part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); goto doArrayExists; case INST_ARRAY_EXISTS_STK: opnd = -1; @@ -3950,11 +3657,8 @@ TEBCresume( goto gotError; } } - if (varPtr && TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) { - objResultPtr = TCONST(1); - } else { - objResultPtr = TCONST(0); - } + objResultPtr = TCONST((varPtr && TclIsVarArray(varPtr) + && !TclIsVarUndefined(varPtr)) ? 1 : 0); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_V(pcAdjustment, cleanup, 1); @@ -3965,10 +3669,7 @@ TEBCresume( part1Ptr = NULL; arrayPtr = NULL; TRACE(("%u => ", opnd)); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); goto doArrayMake; case INST_ARRAY_MAKE_STK: opnd = -1; @@ -4087,7 +3788,7 @@ TEBCresume( */ opnd = TclGetInt4AtPtr(pc+1);; - varPtr = LOCAL(opnd); + varPtr = LOCAL(opnd); /* Not LOCALVAR()! */ if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { if (!TclIsVarUndefined(varPtr)) { @@ -4130,13 +3831,7 @@ TEBCresume( * ----------------------------------------------------------------- */ - case INST_JUMP1: - opnd = TclGetInt1AtPtr(pc+1); - TRACE(("%d => new pc %u\n", opnd, - (unsigned)(pc + opnd - codePtr->codeStart))); - NEXT_INST_F(opnd, 0, 0); - - case INST_JUMP4: + case INST_JUMP: opnd = TclGetInt4AtPtr(pc+1); TRACE(("%d => new pc %u\n", opnd, (unsigned)(pc + opnd - codePtr->codeStart))); @@ -4147,24 +3842,14 @@ TEBCresume( /* TODO: consider rewrite so we don't compute the offset we're not * going to take. */ - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: jmpOffset[0] = TclGetInt4AtPtr(pc+1); /* FALSE offset */ jmpOffset[1] = 5; /* TRUE offset */ goto doCondJump; - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: jmpOffset[0] = 5; jmpOffset[1] = TclGetInt4AtPtr(pc+1); - goto doCondJump; - - case INST_JUMP_FALSE1: - jmpOffset[0] = TclGetInt1AtPtr(pc+1); - jmpOffset[1] = 2; - goto doCondJump; - - case INST_JUMP_TRUE1: - jmpOffset[0] = 2; - jmpOffset[1] = TclGetInt1AtPtr(pc+1); doCondJump: valuePtr = OBJ_AT_TOS; @@ -4172,15 +3857,15 @@ TEBCresume( /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) { - TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[ - ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) - ? 0 : 1]), Tcl_GetObjResult(interp)); + TRACE_WITH_OBJ(("%d => ERROR: ", + jmpOffset[(*pc == INST_JUMP_FALSE) ? 0 : 1]), + Tcl_GetObjResult(interp)); goto gotError; } #ifdef TCL_COMPILE_DEBUG if (b) { - if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { + if (*pc == INST_JUMP_TRUE) { TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], O2S(valuePtr), (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); @@ -4188,7 +3873,7 @@ TEBCresume( TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr))); } } else { - if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { + if (*pc == INST_JUMP_TRUE) { TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr))); } else { TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], @@ -4405,8 +4090,7 @@ TEBCresume( */ { - int index, numIndices, fromIdx, toIdx; - int nocase, match, length2, cflags, s1len, s2len; + int index, fromIdx, toIdx, numIndices, match, s1len, s2len; const char *s1, *s2; case INST_LIST: @@ -4678,7 +4362,7 @@ TEBCresume( * list type. */ - List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1; + List *listPtr = ListRepPtr(valuePtr); if (listPtr->refCount == 1) { TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), @@ -4752,18 +4436,15 @@ TEBCresume( pc++; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif objResultPtr = TCONST(match); NEXT_INST_F(0, 2, 1); + } /* * End of INST_LIST and related instructions. @@ -4771,6 +4452,11 @@ TEBCresume( * Start of string-related instructions. */ + { + int index, fromIdx, toIdx, nocase, match; + int length2, cflags, s1len, s2len; + const char *s1, *s2; + case INST_STR_EQ: case INST_STR_NEQ: /* String (in)equality check */ case INST_STR_CMP: /* String compare. */ @@ -4861,43 +4547,39 @@ TEBCresume( } /* - * Make sure only -1,0,1 is returned - * TODO: consider peephole opt. + * Make sure only -1,0,1 is returned. */ - if (*pc != INST_STR_CMP) { - /* - * Take care of the opcodes that goto'ed into here. - */ - - switch (*pc) { - case INST_STR_EQ: - case INST_EQ: - match = (match == 0); - break; - case INST_STR_NEQ: - case INST_NEQ: - match = (match != 0); - break; - case INST_LT: - match = (match < 0); - break; - case INST_GT: - match = (match > 0); - break; - case INST_LE: - match = (match <= 0); - break; - case INST_GE: - match = (match >= 0); - break; + switch (*pc) { + case INST_STR_CMP: + if (match < 0) { + TclNewIntObj(objResultPtr, -1); + } else { + objResultPtr = TCONST(match > 0); } - } - if (match < 0) { - TclNewIntObj(objResultPtr, -1); - } else { + break; + case INST_STR_EQ: + case INST_EQ: + objResultPtr = TCONST(match == 0); + break; + case INST_STR_NEQ: + case INST_NEQ: + objResultPtr = TCONST(match != 0); + break; + case INST_LT: + objResultPtr = TCONST(match < 0); + break; + case INST_GT: objResultPtr = TCONST(match > 0); + break; + case INST_LE: + objResultPtr = TCONST(match <= 0); + break; + case INST_GE: + objResultPtr = TCONST(match >= 0); + break; } + TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -4971,7 +4653,8 @@ TEBCresume( TclNewObj(objResultPtr); } TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); - NEXT_INST_V(1, 3, 1); + POP_DROP_OBJECT(); + NEXT_INST_F(1, 2, 1); case INST_STR_RANGE_IMM: valuePtr = OBJ_AT_TOS; @@ -5016,35 +4699,34 @@ TEBCresume( Tcl_Obj *value3Ptr; case INST_STR_MAP: - valuePtr = OBJ_AT_TOS; /* "Main" string. */ - value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */ - value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */ + valuePtr = POP_OBJECT(); /* "Main" string. */ + value3Ptr = OBJ_AT_TOS; /* "Target" string. */ + value2Ptr = OBJ_UNDER_TOS; /* "Source" string. */ if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); if (length == 0) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > length || length2 == 0) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } else if (length2 == length) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); - objResultPtr = Tcl_NewUnicodeObj(ustring1, 0); p = ustring1; end = ustring1 + length; @@ -5070,14 +4752,15 @@ TEBCresume( Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } + doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); - NEXT_INST_V(1, 3, 1); + TclDecrRefCount(valuePtr); + NEXT_INST_F(1, 2, 1); case INST_STR_FIND: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ - match = -1; if (length2 > 0 && length2 <= length) { end = ustring1 + length - length2 + 1; @@ -5089,17 +4772,14 @@ TEBCresume( } } } - TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */ ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */ - match = -1; if (length2 > 0 && length2 <= length) { for (p=ustring1+length-length2 ; p>=ustring1 ; p--) { @@ -5110,10 +4790,8 @@ TEBCresume( } } } - TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); } @@ -5161,13 +4839,9 @@ TEBCresume( pc += 2; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif @@ -5190,9 +4864,7 @@ TEBCresume( if (regExpr == NULL) { goto regexpFailure; } - match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0); - if (match < 0) { regexpFailure: #ifdef TCL_COMPILE_DEBUG @@ -5214,13 +4886,9 @@ TEBCresume( pc += 2; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif @@ -5326,13 +4994,9 @@ TEBCresume( pc++; #ifndef TCL_COMPILE_DEBUG switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0); } #endif @@ -5947,7 +5611,7 @@ TEBCresume( int varIndex, valIndex, continueLoop, j, iterTmpIndex; long i; - case INST_FOREACH_START4: + case INST_FOREACH_START: /* * Initialize the temporary local var that holds the count of the * number of iterations of the loop body to -1. @@ -5956,7 +5620,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; iterTmpIndex = infoPtr->loopCtTemp; - iterVarPtr = LOCAL(iterTmpIndex); + LOCALVAR(iterVarPtr, iterTmpIndex); oldValuePtr = iterVarPtr->value.objPtr; if (oldValuePtr == NULL) { @@ -5980,7 +5644,7 @@ TEBCresume( NEXT_INST_F(5, 0, 0); #endif - case INST_FOREACH_STEP4: + case INST_FOREACH_STEP: /* * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. @@ -5994,7 +5658,7 @@ TEBCresume( * Increment the temp holding the loop iteration number. */ - iterVarPtr = LOCAL(infoPtr->loopCtTemp); + LOCALVAR(iterVarPtr, infoPtr->loopCtTemp); valuePtr = iterVarPtr->value.objPtr; iterNum = valuePtr->internalRep.longValue + 1; TclSetLongObj(valuePtr, iterNum); @@ -6010,7 +5674,7 @@ TEBCresume( varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; - listVarPtr = LOCAL(listTmpIndex); + LOCALVAR(listVarPtr, listTmpIndex); listPtr = listVarPtr->value.objPtr; if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ", @@ -6038,7 +5702,7 @@ TEBCresume( varListPtr = infoPtr->varLists[i]; numVars = varListPtr->numVars; - listVarPtr = LOCAL(listTmpIndex); + LOCALVAR(listVarPtr, listTmpIndex); listPtr = TclListObjCopy(NULL, listVarPtr->value.objPtr); TclListObjGetElements(interp, listPtr, &listLen, &elements); @@ -6051,10 +5715,7 @@ TEBCresume( } varIndex = varListPtr->varIndexes[j]; - varPtr = LOCAL(varIndex); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, varIndex); if (TclIsVarDirectWritable(varPtr)) { value2Ptr = varPtr->value.objPtr; if (valuePtr != value2Ptr) { @@ -6093,14 +5754,10 @@ TEBCresume( */ 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); - } + NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); } - case INST_BEGIN_CATCH4: + case INST_BEGIN_CATCH: /* * Record start of the catch command with exception range index equal * to the operand. Push the current stack depth onto the special catch @@ -6157,9 +5814,9 @@ TEBCresume( Tcl_Panic("INST_RETURN_CODE_BRANCH: TOS is TCL_OK!"); } if (code < TCL_ERROR || code > TCL_CONTINUE) { - code = TCL_CONTINUE + 1; + NEXT_INST_F(21, 1, 0); } - NEXT_INST_F(2*code -1, 1, 0); + NEXT_INST_F(5*code -4, 1, 0); } /* @@ -6213,11 +5870,12 @@ TEBCresume( &objResultPtr) == TCL_OK) { if (*pc == INST_DICT_EXISTS) { objResultPtr = TCONST(objResultPtr ? 1 : 0); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(5, opnd+1, 1); } if (objResultPtr) { TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + if (opnd == 1) { + NEXT_INST_F(5, 2, 1); + } NEXT_INST_V(5, opnd+1, 1); } DECACHE_STACK_INFO(); @@ -6233,6 +5891,9 @@ TEBCresume( dictNotExists: objResultPtr = TCONST(0); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + if (opnd == 1) { + NEXT_INST_F(5, 2, 1); + } NEXT_INST_V(5, opnd+1, 1); } TRACE_WITH_OBJ(( @@ -6248,10 +5909,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); - varPtr = LOCAL(opnd2); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd2); TRACE(("%u %u => ", opnd, opnd2)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6283,10 +5941,10 @@ TEBCresume( if (result != TCL_OK) { break; } + TclNewIntObj(value2Ptr, opnd); if (valuePtr == NULL) { - Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS,Tcl_NewIntObj(opnd)); + Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, value2Ptr); } else { - value2Ptr = Tcl_NewIntObj(opnd); Tcl_IncrRefCount(value2Ptr); if (Tcl_IsShared(valuePtr)) { valuePtr = Tcl_DuplicateObj(valuePtr); @@ -6341,21 +5999,24 @@ TEBCresume( goto gotError; } } + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); #ifndef TCL_COMPILE_DEBUG if (*(pc+9) == INST_POP) { + if (cleanup == 2) { + NEXT_INST_F(10, 2, 0); + } NEXT_INST_V(10, cleanup, 0); } #endif - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + if (cleanup == 2) { + NEXT_INST_F(9, 2, 1); + } NEXT_INST_V(9, cleanup, 1); case INST_DICT_APPEND: case INST_DICT_LAPPEND: opnd = TclGetUInt4AtPtr(pc+1); - varPtr = LOCAL(opnd); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, opnd); TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6499,7 +6160,7 @@ TEBCresume( statePtr->typePtr = &dictIteratorType; statePtr->internalRep.twoPtrValue.ptr1 = searchPtr; statePtr->internalRep.twoPtrValue.ptr2 = dictPtr; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); if (varPtr->value.objPtr) { if (varPtr->value.objPtr->typePtr == &dictIteratorType) { Tcl_Panic("mis-issued dictFirst!"); @@ -6513,7 +6174,8 @@ TEBCresume( case INST_DICT_NEXT: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); - statePtr = (*LOCAL(opnd)).value.objPtr; + LOCALVAR(varPtr, opnd); + statePtr = varPtr->value.objPtr; if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) { Tcl_Panic("mis-issued dictNext!"); } @@ -6539,13 +6201,9 @@ TEBCresume( pc += 5; switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); - case INST_JUMP_FALSE4: + case INST_JUMP_FALSE: NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0); - case INST_JUMP_TRUE4: + case INST_JUMP_TRUE: NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0); default: pc -= 5; @@ -6556,17 +6214,13 @@ TEBCresume( TRACE_APPEND(("\"%.30s\" \"%.30s\" %d", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); objResultPtr = TCONST(done); - /* TODO: consider opt like INST_FOREACH_STEP4 */ NEXT_INST_F(5, 0, 1); case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6591,10 +6245,7 @@ TEBCresume( &valuePtr) != TCL_OK) { goto gotError; } - varPtr = LOCAL(duiPtr->varIndices[i]); - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } + LOCALVAR(varPtr, duiPtr->varIndices[i]); DECACHE_STACK_INFO(); if (valuePtr == NULL) { TclObjUnsetVar2(interp, @@ -6613,11 +6264,8 @@ TEBCresume( case INST_DICT_UPDATE_END: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; @@ -6642,11 +6290,9 @@ TEBCresume( TclInvalidateStringRep(dictPtr); } for (i=0 ; i<length ; i++) { - Var *var2Ptr = LOCAL(duiPtr->varIndices[i]); + Var *var2Ptr; - while (TclIsVarLink(var2Ptr)) { - var2Ptr = var2Ptr->value.linkPtr; - } + LOCALVAR(var2Ptr, duiPtr->varIndices[i]); if (TclIsVarDirectReadable(var2Ptr)) { valuePtr = var2Ptr->value.objPtr; } else { @@ -6733,16 +6379,13 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc+1); listPtr = OBJ_UNDER_TOS; keysPtr = OBJ_AT_TOS; - varPtr = LOCAL(opnd); + LOCALVAR(varPtr, opnd); TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr), O2S(keysPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); goto gotError; } - while (TclIsVarLink(varPtr)) { - varPtr = varPtr->value.linkPtr; - } DECACHE_STACK_INFO(); result = TclDictWithFinish(interp, varPtr, NULL, NULL, NULL, opnd, objc, objv, keysPtr); @@ -6785,11 +6428,7 @@ TEBCresume( processExceptionReturn: #if TCL_COMPILE_DEBUG switch (*pc) { - case INST_INVOKE_STK1: - opnd = TclGetUInt1AtPtr(pc+1); - TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); - break; - case INST_INVOKE_STK4: + case INST_INVOKE_STK: opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ... after \"%.20s\": ", opnd, cmdNameBuf)); break; @@ -6817,8 +6456,7 @@ TEBCresume( goto processCatch; } while (cleanup--) { - valuePtr = POP_OBJECT(); - TclDecrRefCount(valuePtr); + POP_DROP_OBJECT(); } if (result == TCL_BREAK) { result = TCL_OK; @@ -6994,8 +6632,7 @@ TEBCresume( processCatch: while (CURR_DEPTH > *catchTop) { - valuePtr = POP_OBJECT(); - TclDecrRefCount(valuePtr); + POP_DROP_OBJECT(); } #ifdef TCL_COMPILE_DEBUG if (traceInstructions) { @@ -7032,8 +6669,7 @@ TEBCresume( POP_TAUX_OBJ(); } while (tosPtr > initTosPtr) { - objPtr = POP_OBJECT(); - Tcl_DecrRefCount(objPtr); + POP_DROP_OBJECT(); } if (tosPtr < initTosPtr) { @@ -7066,30 +6702,30 @@ TEBCresume( * case INST_START_CMD: */ - instStartCmdFailed: - { - const char *bytes; - - checkInterp = 1; - length = 0; + instStartCmdFailed: + { + const char *bytes; - /* - * We used to switch to direct eval; for NRE-awareness we now - * compile and eval the command so that this evaluation does not - * add a new TEBC instance. [Bug 2910748] - */ + checkInterp = 1; + length = 0; - if (TclInterpReady(interp) == TCL_ERROR) { - goto gotError; - } + /* + * We used to switch to direct eval; for NRE-awareness we now compile + * and eval the command so that this evaluation does not add a new + * TEBC instance. [Bug 2910748] + */ - codePtr->flags |= TCL_BYTECODE_RECOMPILE; - bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL); - opnd = TclGetUInt4AtPtr(pc+1); - pc += (opnd-1); - PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); - goto instEvalStk; + if (TclInterpReady(interp) == TCL_ERROR) { + goto gotError; } + + codePtr->flags |= TCL_BYTECODE_RECOMPILE; + bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL); + opnd = TclGetUInt4AtPtr(pc+1); + pc += (opnd-1); + PUSH_OBJECT(Tcl_NewStringObj(bytes, length)); + goto instEvalStk; + } } #undef codePtr @@ -8461,7 +8097,6 @@ TclCompareTwoNumbers( } } -#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -8480,6 +8115,7 @@ TclCompareTwoNumbers( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_DEBUG static void PrintByteCodeInfo( register ByteCode *codePtr) /* The bytecode whose summary is printed to @@ -8634,16 +8270,7 @@ IllegalExprOperandType( } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { - int numBytes; - const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes); - - if (numBytes == 0) { - description = "empty string"; - } else if (TclCheckBadOctal(NULL, bytes)) { - description = "invalid octal number"; - } else { - description = "non-numeric string"; - } + description = "non-numeric string"; } else if (type == TCL_NUMBER_NAN) { description = "non-numeric floating-point value"; } else if (type == TCL_NUMBER_DOUBLE) { @@ -8654,7 +8281,8 @@ IllegalExprOperandType( } Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't use %s as operand of \"%s\"", description, operator)); + "can't use %s \"%s\" as operand of \"%s\"", description, + Tcl_GetString(opndPtr), operator)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL); } @@ -9021,7 +8649,6 @@ TclExprFloatError( } } -#ifdef TCL_COMPILE_STATS /* *---------------------------------------------------------------------- * @@ -9040,6 +8667,7 @@ TclExprFloatError( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_STATS int TclLog2( register int value) /* The integer for which to compute the log @@ -9054,6 +8682,7 @@ TclLog2( } return result; } +#endif /* TCL_COMPILE_STATS */ /* *---------------------------------------------------------------------- @@ -9072,6 +8701,7 @@ TclLog2( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_STATS static int EvalStatsCmd( ClientData unused, /* Unused. */ @@ -9476,7 +9106,6 @@ EvalStatsCmd( } #endif /* TCL_COMPILE_STATS */ -#ifdef TCL_COMPILE_DEBUG /* *---------------------------------------------------------------------- * @@ -9498,6 +9127,7 @@ EvalStatsCmd( *---------------------------------------------------------------------- */ +#ifdef TCL_COMPILE_DEBUG static const char * StringForResultCode( int result) /* The Tcl result code for which to generate a diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 193ca4e..f362239 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -38,6 +38,15 @@ static Tcl_Obj * SplitUnixPath(const char *path); static int DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr, const char *separators, Tcl_Obj *pathPtr, int flags, char *pattern, Tcl_GlobTypeData *types); +static int TclGlob(Tcl_Interp *interp, char *pattern, + Tcl_Obj *pathPrefix, int globFlags, + Tcl_GlobTypeData *types); + +/* Flag values used by TclGlob() */ + +#define TCL_GLOBMODE_JOIN 2 +#define TCL_GLOBMODE_DIR 4 +#define TCL_GLOBMODE_TAILS 8 /* * When there is no support for getting the block size of a file in a stat() @@ -1271,7 +1280,10 @@ Tcl_GlobObjCmd( switch (index) { case GLOB_NOCOMPLAIN: /* -nocomplain */ - globFlags |= TCL_GLOBMODE_NO_COMPLAIN; + /* + * Do nothing; This is normal operations in Tcl 9. + * Keep accepting as a no-op option to accommodate old scripts. + */ break; case GLOB_DIR: /* -dir */ if (i == (objc-1)) { @@ -1621,41 +1633,6 @@ Tcl_GlobObjCmd( } } - if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) { - if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp), - &length) != TCL_OK) { - /* - * This should never happen. Maybe we should be more dramatic. - */ - - result = TCL_ERROR; - goto endOfGlob; - } - - if (length == 0) { - Tcl_Obj *errorMsg = - Tcl_ObjPrintf("no files matched glob pattern%s \"", - (join || (objc == 1)) ? "" : "s"); - - if (join) { - Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1); - } else { - const char *sep = ""; - - for (i = 0; i < objc; i++) { - Tcl_AppendPrintfToObj(errorMsg, "%s%s", - sep, Tcl_GetString(objv[i])); - sep = " "; - } - } - Tcl_AppendToObj(errorMsg, "\"", -1); - Tcl_SetObjResult(interp, errorMsg); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH", - NULL); - result = TCL_ERROR; - } - } - endOfGlob: if (join || (dir == PATH_GENERAL)) { Tcl_DStringFree(&prefix); @@ -1706,7 +1683,7 @@ Tcl_GlobObjCmd( */ /* ARGSUSED */ -int +static int TclGlob( Tcl_Interp *interp, /* Interpreter for returning error message or * appending list of matching file names. */ diff --git a/generic/tclHistory.c b/generic/tclHistory.c index b10d423..c44ba4c 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -75,13 +75,6 @@ Tcl_RecordAndEval( 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. */ diff --git a/generic/tclIO.c b/generic/tclIO.c index 715c1ef..0568d77 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7059,47 +7059,6 @@ Tcl_Tell( /* *--------------------------------------------------------------------------- * - * Tcl_SeekOld, Tcl_TellOld -- - * - * Backward-compatability versions of the seek/tell interface that do not - * support 64-bit offsets. This interface is not documented or expected - * to be supported indefinitely. - * - * Results: - * As for Tcl_Seek and Tcl_Tell respectively, except truncated to - * whatever value will fit in an 'int'. - * - * Side effects: - * As for Tcl_Seek and Tcl_Tell respectively. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_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); -} - -int -Tcl_TellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); -} - -/* - *--------------------------------------------------------------------------- - * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. @@ -9006,18 +8965,6 @@ ZeroTransferTimerProc( */ 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); -} - -int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 1673bce..4ade3a9 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -139,19 +139,6 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if 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 diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index f523e8f..6541c3d 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -408,22 +408,6 @@ Tcl_GetCwd( return Tcl_DStringValue(cwdPtr); } -/* Obsolete */ -int -Tcl_EvalFile( - Tcl_Interp *interp, /* Interpreter in which to process file. */ - const char *fileName) /* Name of file to process. Tilde-substitution - * will be performed on this name. */ -{ - int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); - - Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSEvalFile(interp, pathPtr); - Tcl_DecrRefCount(pathPtr); - return ret; -} - /* * Now move on to the basic filesystem implementation. */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index f0e907f..edb3046 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -51,10 +51,11 @@ declare 6 { declare 7 { int TclCopyAndCollapse(int count, const char *src, char *dst) } -declare 8 { - int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, - Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) -} +# Removed in Tcl 9 +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. @@ -184,11 +185,11 @@ declare 41 { Tcl_Command TclGetOriginalCommand(Tcl_Command command) } declare 42 { - CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) + const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } # Removed in Tcl 8.5a2 #declare 43 { -# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 44 { @@ -223,12 +224,12 @@ declare 51 { } # Removed in Tcl 8.5a2 #declare 52 { -# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 53 { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, - int argc, CONST84 char **argv) + int argc, const char **argv) } declare 54 { int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, @@ -315,10 +316,10 @@ declare 76 { unsigned long TclpGetSeconds(void) } -# deprecated -declare 77 { - void TclpGetTime(Tcl_Time *time) -} +# Removed in 9.0: +#declare 77 { +# void TclpGetTime(Tcl_Time *time) +#} # Removed in 8.6: #declare 78 { # int TclpGetTimeZone(unsigned long time) @@ -411,7 +412,7 @@ declare 98 { # Tcl_Obj *objPtr, int flags) #} declare 101 { - CONST86 char *TclSetPreInitScript(const char *string) + const char *TclSetPreInitScript(const char *string) } declare 102 { void TclSetupEnv(Tcl_Interp *interp) @@ -420,9 +421,10 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } -declare 104 { - int TclSockMinimumBuffersOld(int sock, int size) -} +# Removed in Tcl 9 +#declare 104 { +# int TclSockMinimumBuffersOld(int sock, int size) +#} # Replaced by Tcl_FSStat in 8.4: #declare 105 { # int TclStat(const char *path, Tcl_StatBuf *buf) @@ -533,9 +535,10 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } -declare 133 { - struct tm *TclpGetDate(const time_t *time, int useGMT) -} +# Removed in 9.0 +#declare 133 { +# 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, @@ -551,7 +554,7 @@ declare 133 { # int TclpChdir(const char *dirName) #} declare 138 { - CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr) + const char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } #declare 139 { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, @@ -563,7 +566,7 @@ declare 138 { #} # This is used by TclX, but should otherwise be considered private declare 141 { - CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) + const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -749,14 +752,14 @@ declare 179 { # const char *file, int line) #} -# TclpGmtime and TclpLocaltime promoted to the generic interface from unix - -declare 182 { - struct tm *TclpLocaltime(const time_t *clock) -} -declare 183 { - struct tm *TclpGmtime(const time_t *clock) -} +# 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) +#} # For the new "Thread Storage" subsystem. @@ -941,9 +944,9 @@ declare 235 { # TIP 337 made this one public -declare 236 { - void TclBackgroundException(Tcl_Interp *interp, int code) -} +#declare 236 { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 { @@ -1020,9 +1023,10 @@ interface tclIntPlat declare 0 win { void TclWinConvertError(DWORD errCode) } -declare 1 win { - void TclWinConvertWSAError(DWORD errCode) -} +# Removed in Tcl 9.0 +#declare 1 win { +# void TclWinConvertWSAError(DWORD errCode) +#} declare 2 win { struct servent *TclWinGetServByName(const char *nm, const char *proto) @@ -1197,14 +1201,13 @@ declare 9 unix { declare 10 unix { Tcl_DirEntry *TclpReaddir(DIR *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) -} +# Removed in Tcl 9.0 +#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) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 18768d9..cbfc105 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -152,13 +152,13 @@ typedef struct Tcl_ResolvedVarInfo { } Tcl_ResolvedVarInfo; typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, - CONST84 char *name, int length, Tcl_Namespace *context, + const char *name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr); -typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name, +typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr); -typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name, +typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr); typedef struct Tcl_ResolverInfo { @@ -1493,7 +1493,8 @@ typedef struct CoroutineData { typedef struct ExecEnv { ExecStack *execStackPtr; /* Points to the first item in the evaluation * stack on the heap. */ - Tcl_Obj *constants[2]; /* Pointers to constant "0" and "1" objs. */ + Tcl_Obj *constants[2]; /* Pointers to constant "-1", "0" and "1" + * objs. */ struct Tcl_Interp *interp; struct NRE_callback *callbackPtr; /* Top callback in NRE's stack. */ @@ -1799,42 +1800,33 @@ typedef struct AllocCache { */ typedef struct Interp { + /* - * 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. + * 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. */ - 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. */ + const char *legacyResult; + void (*legacyFreeProc) (void); 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. 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. */ + /* 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. + */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1847,8 +1839,6 @@ typedef struct Interp { ClientData interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */ - /* * Information related to procedures and variables. See tclProc.c and * tclVar.c for usage. @@ -1878,19 +1868,6 @@ typedef struct Interp { * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */ /* - * Information used by Tcl_AppendResult to keep track of partial results. - * See Tcl_AppendResult code for details. - */ - - 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. */ - - /* * Information about packages. Used only in tclPkg.c. */ @@ -1912,7 +1889,6 @@ 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 @@ -1950,8 +1926,6 @@ typedef struct Interp { * string. Returned by Tcl_ObjSetVar2 when * variable traces change a variable in a * gross way. */ - char resultSpace[TCL_RESULT_SIZE+1]; - /* Static space holding small results. */ Tcl_Obj *objResultPtr; /* If the last command returned an object * result, this points to it. Should not be * accessed directly; see comment above. */ @@ -2591,16 +2565,6 @@ typedef struct TclFileAttrProcs { typedef struct TclFile_ *TclFile; -/* - * The "globParameters" argument of the function TclGlob is an or'ed - * combination of the following values: - */ - -#define TCL_GLOBMODE_NO_COMPLAIN 1 -#define TCL_GLOBMODE_JOIN 2 -#define TCL_GLOBMODE_DIR 4 -#define TCL_GLOBMODE_TAILS 8 - typedef enum Tcl_PathPart { TCL_PATH_DIRNAME, TCL_PATH_TAIL, @@ -2906,8 +2870,6 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, int strLen, const unsigned char *pattern, int ptnLen, int flags); MODULE_SCOPE double TclCeil(const mp_int *a); -MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp, - const char *value); MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; @@ -2986,9 +2948,6 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, int *binaryPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr); -MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern, - Tcl_Obj *unquotedPrefix, int globFlags, - Tcl_GlobTypeData *types); MODULE_SCOPE int TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr, Tcl_Obj *incrPtr); MODULE_SCOPE Tcl_Obj * TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, @@ -3210,9 +3169,6 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp); MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -4542,6 +4498,19 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclNewLongObj(objPtr, l) \ TclNewIntObj((objPtr), (l)) +#ifndef NO_WIDE_TYPE +#define TclNewWideIntObj(objPtr, w) \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclWideIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ + } while (0) +#endif /*!NO_WIDE_TYPE*/ + /* * NOTE: There is to be no such thing as a "pure" boolean. * See comment above TclSetBooleanObj macro above. @@ -4577,6 +4546,11 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; #define TclNewLongObj(objPtr, l) \ (objPtr) = Tcl_NewLongObj(l) +#ifndef NO_WIDE_TYPE +#define TclNewWideIntObj(objPtr, w) \ + (objPtr) = Tcl_NewWideIntObj(w) +#endif /*!NO_WIDE_TYPE*/ + #define TclNewBooleanObj(objPtr, b) \ (objPtr) = Tcl_NewBooleanObj(b) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index cf88e5f..d1615e0 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -17,17 +17,6 @@ #include "tclPort.h" -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */ #undef Tcl_CreateNamespace #undef Tcl_DeleteNamespace @@ -60,166 +49,162 @@ /* Slot 1 is reserved */ /* Slot 2 is reserved */ /* 3 */ -EXTERN void TclAllocateFreeObjects(void); +TCLAPI void TclAllocateFreeObjects(void); /* Slot 4 is reserved */ /* 5 */ -EXTERN int TclCleanupChildren(Tcl_Interp *interp, int numPids, +TCLAPI int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 6 */ -EXTERN void TclCleanupCommand(Command *cmdPtr); +TCLAPI void TclCleanupCommand(Command *cmdPtr); /* 7 */ -EXTERN int TclCopyAndCollapse(int count, const char *src, +TCLAPI int TclCopyAndCollapse(int count, const char *src, char *dst); -/* 8 */ -EXTERN int TclCopyChannelOld(Tcl_Interp *interp, - Tcl_Channel inChan, Tcl_Channel outChan, - int toRead, Tcl_Obj *cmdPtr); +/* Slot 8 is reserved */ /* 9 */ -EXTERN int TclCreatePipeline(Tcl_Interp *interp, int argc, +TCLAPI int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 10 */ -EXTERN int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, +TCLAPI int TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 11 */ -EXTERN void TclDeleteCompiledLocalVars(Interp *iPtr, +TCLAPI void TclDeleteCompiledLocalVars(Interp *iPtr, CallFrame *framePtr); /* 12 */ -EXTERN void TclDeleteVars(Interp *iPtr, +TCLAPI void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr); /* Slot 13 is reserved */ /* 14 */ -EXTERN int TclDumpMemoryInfo(ClientData clientData, int flags); +TCLAPI int TclDumpMemoryInfo(ClientData clientData, int flags); /* Slot 15 is reserved */ /* 16 */ -EXTERN void TclExprFloatError(Tcl_Interp *interp, double value); +TCLAPI void TclExprFloatError(Tcl_Interp *interp, double value); /* Slot 17 is reserved */ /* Slot 18 is reserved */ /* Slot 19 is reserved */ /* Slot 20 is reserved */ /* Slot 21 is reserved */ /* 22 */ -EXTERN int TclFindElement(Tcl_Interp *interp, +TCLAPI int TclFindElement(Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 23 */ -EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName); +TCLAPI Proc * TclFindProc(Interp *iPtr, const char *procName); /* 24 */ -EXTERN int TclFormatInt(char *buffer, long n); +TCLAPI int TclFormatInt(char *buffer, long n); /* 25 */ -EXTERN void TclFreePackageInfo(Interp *iPtr); +TCLAPI void TclFreePackageInfo(Interp *iPtr); /* Slot 26 is reserved */ /* Slot 27 is reserved */ /* 28 */ -EXTERN Tcl_Channel TclpGetDefaultStdChannel(int type); +TCLAPI Tcl_Channel TclpGetDefaultStdChannel(int type); /* Slot 29 is reserved */ /* Slot 30 is reserved */ /* 31 */ -EXTERN const char * TclGetExtension(const char *name); +TCLAPI const char * TclGetExtension(const char *name); /* 32 */ -EXTERN int TclGetFrame(Tcl_Interp *interp, const char *str, +TCLAPI int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* Slot 33 is reserved */ /* 34 */ -EXTERN int TclGetIntForIndex(Tcl_Interp *interp, +TCLAPI int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* Slot 35 is reserved */ /* Slot 36 is reserved */ /* 37 */ -EXTERN int TclGetLoadedPackages(Tcl_Interp *interp, +TCLAPI int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName); /* 38 */ -EXTERN int TclGetNamespaceForQualName(Tcl_Interp *interp, +TCLAPI int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 39 */ -EXTERN TclObjCmdProcType TclGetObjInterpProc(void); +TCLAPI TclObjCmdProcType TclGetObjInterpProc(void); /* 40 */ -EXTERN int TclGetOpenMode(Tcl_Interp *interp, const char *str, +TCLAPI int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 41 */ -EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); +TCLAPI Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ -EXTERN CONST86 char * TclpGetUserHome(const char *name, +TCLAPI const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); /* Slot 43 is reserved */ /* 44 */ -EXTERN int TclGuessPackageName(const char *fileName, +TCLAPI int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr); /* 45 */ -EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); +TCLAPI int TclHideUnsafeCommands(Tcl_Interp *interp); /* 46 */ -EXTERN int TclInExit(void); +TCLAPI int TclInExit(void); /* Slot 47 is reserved */ /* Slot 48 is reserved */ /* Slot 49 is reserved */ /* 50 */ -EXTERN void TclInitCompiledLocals(Tcl_Interp *interp, +TCLAPI void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 51 */ -EXTERN int TclInterpInit(Tcl_Interp *interp); +TCLAPI int TclInterpInit(Tcl_Interp *interp); /* Slot 52 is reserved */ /* 53 */ -EXTERN int TclInvokeObjectCommand(ClientData clientData, +TCLAPI int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, - CONST84 char **argv); + const char **argv); /* 54 */ -EXTERN int TclInvokeStringCommand(ClientData clientData, +TCLAPI int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 55 */ -EXTERN Proc * TclIsProc(Command *cmdPtr); +TCLAPI Proc * TclIsProc(Command *cmdPtr); /* Slot 56 is reserved */ /* Slot 57 is reserved */ /* 58 */ -EXTERN Var * TclLookupVar(Tcl_Interp *interp, const char *part1, +TCLAPI Var * TclLookupVar(Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* Slot 59 is reserved */ /* 60 */ -EXTERN int TclNeedSpace(const char *start, const char *end); +TCLAPI int TclNeedSpace(const char *start, const char *end); /* 61 */ -EXTERN Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); +TCLAPI Tcl_Obj * TclNewProcBodyObj(Proc *procPtr); /* 62 */ -EXTERN int TclObjCommandComplete(Tcl_Obj *cmdPtr); +TCLAPI int TclObjCommandComplete(Tcl_Obj *cmdPtr); /* 63 */ -EXTERN int TclObjInterpProc(ClientData clientData, +TCLAPI int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 64 */ -EXTERN int TclObjInvoke(Tcl_Interp *interp, int objc, +TCLAPI int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* Slot 65 is reserved */ /* Slot 66 is reserved */ /* Slot 67 is reserved */ /* Slot 68 is reserved */ /* 69 */ -EXTERN char * TclpAlloc(unsigned int size); +TCLAPI char * TclpAlloc(unsigned int size); /* Slot 70 is reserved */ /* Slot 71 is reserved */ /* Slot 72 is reserved */ /* Slot 73 is reserved */ /* 74 */ -EXTERN void TclpFree(char *ptr); +TCLAPI void TclpFree(char *ptr); /* 75 */ -EXTERN unsigned long TclpGetClicks(void); +TCLAPI unsigned long TclpGetClicks(void); /* 76 */ -EXTERN unsigned long TclpGetSeconds(void); -/* 77 */ -EXTERN void TclpGetTime(Tcl_Time *time); +TCLAPI unsigned long TclpGetSeconds(void); +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ /* 81 */ -EXTERN char * TclpRealloc(char *ptr, unsigned int size); +TCLAPI char * TclpRealloc(char *ptr, unsigned int size); /* Slot 82 is reserved */ /* Slot 83 is reserved */ /* Slot 84 is reserved */ @@ -227,242 +212,236 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size); /* Slot 86 is reserved */ /* Slot 87 is reserved */ /* 88 */ -EXTERN char * TclPrecTraceProc(ClientData clientData, +TCLAPI char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 89 */ -EXTERN int TclPreventAliasLoop(Tcl_Interp *interp, +TCLAPI int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* Slot 90 is reserved */ /* 91 */ -EXTERN void TclProcCleanupProc(Proc *procPtr); +TCLAPI void TclProcCleanupProc(Proc *procPtr); /* 92 */ -EXTERN int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, +TCLAPI int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 93 */ -EXTERN void TclProcDeleteProc(ClientData clientData); +TCLAPI void TclProcDeleteProc(ClientData clientData); /* Slot 94 is reserved */ /* Slot 95 is reserved */ /* 96 */ -EXTERN int TclRenameCommand(Tcl_Interp *interp, +TCLAPI int TclRenameCommand(Tcl_Interp *interp, const char *oldName, const char *newName); /* 97 */ -EXTERN void TclResetShadowedCmdRefs(Tcl_Interp *interp, +TCLAPI void TclResetShadowedCmdRefs(Tcl_Interp *interp, Command *newCmdPtr); /* 98 */ -EXTERN int TclServiceIdle(void); +TCLAPI int TclServiceIdle(void); /* Slot 99 is reserved */ /* Slot 100 is reserved */ /* 101 */ -EXTERN CONST86 char * TclSetPreInitScript(const char *string); +TCLAPI const char * TclSetPreInitScript(const char *string); /* 102 */ -EXTERN void TclSetupEnv(Tcl_Interp *interp); +TCLAPI void TclSetupEnv(Tcl_Interp *interp); /* 103 */ -EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str, +TCLAPI int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); -/* 104 */ -EXTERN int TclSockMinimumBuffersOld(int sock, int size); +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ /* 108 */ -EXTERN void TclTeardownNamespace(Namespace *nsPtr); +TCLAPI void TclTeardownNamespace(Namespace *nsPtr); /* 109 */ -EXTERN int TclUpdateReturnInfo(Interp *iPtr); +TCLAPI int TclUpdateReturnInfo(Interp *iPtr); /* 110 */ -EXTERN int TclSockMinimumBuffers(void *sock, int size); +TCLAPI int TclSockMinimumBuffers(void *sock, int size); /* 111 */ -EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp, +TCLAPI void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 112 */ -EXTERN int Tcl_AppendExportList(Tcl_Interp *interp, +TCLAPI int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 113 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 114 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); +TCLAPI void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); /* 115 */ -EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 116 */ -EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +TCLAPI Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, +TCLAPI Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 118 */ -EXTERN int Tcl_GetInterpResolvers(Tcl_Interp *interp, +TCLAPI int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 119 */ -EXTERN int Tcl_GetNamespaceResolvers( +TCLAPI int Tcl_GetNamespaceResolvers( Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 120 */ -EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, +TCLAPI Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 121 */ -EXTERN int Tcl_ForgetImport(Tcl_Interp *interp, +TCLAPI int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 122 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, +TCLAPI Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 123 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, +TCLAPI void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 124 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); /* 125 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +TCLAPI Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); /* 126 */ -EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp, +TCLAPI void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 127 */ -EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +TCLAPI int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 128 */ -EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp); +TCLAPI void Tcl_PopCallFrame(Tcl_Interp *interp); /* 129 */ -EXTERN int Tcl_PushCallFrame(Tcl_Interp *interp, +TCLAPI int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 130 */ -EXTERN int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, +TCLAPI int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name); /* 131 */ -EXTERN void Tcl_SetNamespaceResolvers( +TCLAPI void Tcl_SetNamespaceResolvers( Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 132 */ -EXTERN int TclpHasSockets(Tcl_Interp *interp); -/* 133 */ -EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT); +TCLAPI int TclpHasSockets(Tcl_Interp *interp); +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ -EXTERN CONST84_RETURN char * TclGetEnv(const char *name, - Tcl_DString *valuePtr); +TCLAPI const char * TclGetEnv(const char *name, Tcl_DString *valuePtr); /* Slot 139 is reserved */ /* Slot 140 is reserved */ /* 141 */ -EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp, - Tcl_DString *cwdPtr); +TCLAPI const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ -EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, +TCLAPI int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 143 */ -EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, +TCLAPI int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 144 */ -EXTERN void TclHideLiteral(Tcl_Interp *interp, +TCLAPI void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 145 */ -EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName); +TCLAPI const struct AuxDataType * TclGetAuxDataType(const char *typeName); /* 146 */ -EXTERN TclHandle TclHandleCreate(void *ptr); +TCLAPI TclHandle TclHandleCreate(void *ptr); /* 147 */ -EXTERN void TclHandleFree(TclHandle handle); +TCLAPI void TclHandleFree(TclHandle handle); /* 148 */ -EXTERN TclHandle TclHandlePreserve(TclHandle handle); +TCLAPI TclHandle TclHandlePreserve(TclHandle handle); /* 149 */ -EXTERN void TclHandleRelease(TclHandle handle); +TCLAPI void TclHandleRelease(TclHandle handle); /* 150 */ -EXTERN int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); +TCLAPI int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re); /* 151 */ -EXTERN void TclRegExpRangeUniChar(Tcl_RegExp re, int index, +TCLAPI void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 152 */ -EXTERN void TclSetLibraryPath(Tcl_Obj *pathPtr); +TCLAPI void TclSetLibraryPath(Tcl_Obj *pathPtr); /* 153 */ -EXTERN Tcl_Obj * TclGetLibraryPath(void); +TCLAPI Tcl_Obj * TclGetLibraryPath(void); /* Slot 154 is reserved */ /* Slot 155 is reserved */ /* 156 */ -EXTERN void TclRegError(Tcl_Interp *interp, const char *msg, +TCLAPI void TclRegError(Tcl_Interp *interp, const char *msg, int status); /* 157 */ -EXTERN Var * TclVarTraceExists(Tcl_Interp *interp, +TCLAPI Var * TclVarTraceExists(Tcl_Interp *interp, const char *varName); /* 158 */ -EXTERN void TclSetStartupScriptFileName(const char *filename); +TCLAPI void TclSetStartupScriptFileName(const char *filename); /* 159 */ -EXTERN const char * TclGetStartupScriptFileName(void); +TCLAPI const char * TclGetStartupScriptFileName(void); /* Slot 160 is reserved */ /* 161 */ -EXTERN int TclChannelTransform(Tcl_Interp *interp, +TCLAPI int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 162 */ -EXTERN void TclChannelEventScriptInvoker(ClientData clientData, +TCLAPI void TclChannelEventScriptInvoker(ClientData clientData, int flags); /* 163 */ -EXTERN const void * TclGetInstructionTable(void); +TCLAPI const void * TclGetInstructionTable(void); /* 164 */ -EXTERN void TclExpandCodeArray(void *envPtr); +TCLAPI void TclExpandCodeArray(void *envPtr); /* 165 */ -EXTERN void TclpSetInitialEncodings(void); +TCLAPI void TclpSetInitialEncodings(void); /* 166 */ -EXTERN int TclListObjSetElement(Tcl_Interp *interp, +TCLAPI int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 167 */ -EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr); +TCLAPI void TclSetStartupScriptPath(Tcl_Obj *pathPtr); /* 168 */ -EXTERN Tcl_Obj * TclGetStartupScriptPath(void); +TCLAPI Tcl_Obj * TclGetStartupScriptPath(void); /* 169 */ -EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, +TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n); /* 170 */ -EXTERN int TclCheckInterpTraces(Tcl_Interp *interp, +TCLAPI int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ -EXTERN int TclCheckExecutionTraces(Tcl_Interp *interp, +TCLAPI int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 172 */ -EXTERN int TclInThreadExit(void); +TCLAPI int TclInThreadExit(void); /* 173 */ -EXTERN int TclUniCharMatch(const Tcl_UniChar *string, +TCLAPI int TclUniCharMatch(const Tcl_UniChar *string, int strLen, const Tcl_UniChar *pattern, int ptnLen, int flags); /* Slot 174 is reserved */ /* 175 */ -EXTERN int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, +TCLAPI int TclCallVarTraces(Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 176 */ -EXTERN void TclCleanupVar(Var *varPtr, Var *arrayPtr); +TCLAPI void TclCleanupVar(Var *varPtr, Var *arrayPtr); /* 177 */ -EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1, +TCLAPI void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 178 */ -EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr, +TCLAPI void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName); /* 179 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); +TCLAPI Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); /* Slot 180 is reserved */ /* Slot 181 is reserved */ -/* 182 */ -EXTERN struct tm * TclpLocaltime(const time_t *clock); -/* 183 */ -EXTERN struct tm * TclpGmtime(const time_t *clock); +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -478,137 +457,136 @@ EXTERN struct tm * TclpGmtime(const time_t *clock); /* Slot 196 is reserved */ /* Slot 197 is reserved */ /* 198 */ -EXTERN int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* Slot 199 is reserved */ /* 200 */ -EXTERN int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, +TCLAPI int TclpObjRemoveDirectory(Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 201 */ -EXTERN int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, +TCLAPI int TclpObjCopyDirectory(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 202 */ -EXTERN int TclpObjCreateDirectory(Tcl_Obj *pathPtr); +TCLAPI int TclpObjCreateDirectory(Tcl_Obj *pathPtr); /* 203 */ -EXTERN int TclpObjDeleteFile(Tcl_Obj *pathPtr); +TCLAPI int TclpObjDeleteFile(Tcl_Obj *pathPtr); /* 204 */ -EXTERN int TclpObjCopyFile(Tcl_Obj *srcPathPtr, +TCLAPI int TclpObjCopyFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */ -EXTERN int TclpObjRenameFile(Tcl_Obj *srcPathPtr, +TCLAPI int TclpObjRenameFile(Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 206 */ -EXTERN int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); +TCLAPI int TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 207 */ -EXTERN int TclpObjAccess(Tcl_Obj *pathPtr, int mode); +TCLAPI int TclpObjAccess(Tcl_Obj *pathPtr, int mode); /* 208 */ -EXTERN Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, +TCLAPI Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* Slot 209 is reserved */ /* Slot 210 is reserved */ /* Slot 211 is reserved */ /* 212 */ -EXTERN void TclpFindExecutable(const char *argv0); +TCLAPI void TclpFindExecutable(const char *argv0); /* 213 */ -EXTERN Tcl_Obj * TclGetObjNameOfExecutable(void); +TCLAPI Tcl_Obj * TclGetObjNameOfExecutable(void); /* 214 */ -EXTERN void TclSetObjNameOfExecutable(Tcl_Obj *name, +TCLAPI void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding); /* 215 */ -EXTERN void * TclStackAlloc(Tcl_Interp *interp, int numBytes); +TCLAPI void * TclStackAlloc(Tcl_Interp *interp, int numBytes); /* 216 */ -EXTERN void TclStackFree(Tcl_Interp *interp, void *freePtr); +TCLAPI void TclStackFree(Tcl_Interp *interp, void *freePtr); /* 217 */ -EXTERN int TclPushStackFrame(Tcl_Interp *interp, +TCLAPI int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 218 */ -EXTERN void TclPopStackFrame(Tcl_Interp *interp); +TCLAPI void TclPopStackFrame(Tcl_Interp *interp); /* Slot 219 is reserved */ /* Slot 220 is reserved */ /* Slot 221 is reserved */ /* Slot 222 is reserved */ /* Slot 223 is reserved */ /* 224 */ -EXTERN TclPlatformType * TclGetPlatform(void); +TCLAPI TclPlatformType * TclGetPlatform(void); /* 225 */ -EXTERN Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, +TCLAPI Tcl_Obj * TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 226 */ -EXTERN int TclObjBeingDeleted(Tcl_Obj *objPtr); +TCLAPI int TclObjBeingDeleted(Tcl_Obj *objPtr); /* 227 */ -EXTERN void TclSetNsPath(Namespace *nsPtr, int pathLength, +TCLAPI void TclSetNsPath(Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* Slot 228 is reserved */ /* 229 */ -EXTERN int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, +TCLAPI int TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 230 */ -EXTERN Var * TclObjLookupVar(Tcl_Interp *interp, +TCLAPI Var * TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 231 */ -EXTERN int TclGetNamespaceFromObj(Tcl_Interp *interp, +TCLAPI int TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 232 */ -EXTERN int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 233 */ -EXTERN void TclGetSrcInfoForPc(CmdFrame *contextPtr); +TCLAPI void TclGetSrcInfoForPc(CmdFrame *contextPtr); /* 234 */ -EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, +TCLAPI Var * TclVarHashCreateVar(TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 235 */ -EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr, +TCLAPI void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr); -/* 236 */ -EXTERN void TclBackgroundException(Tcl_Interp *interp, int code); +/* Slot 236 is reserved */ /* 237 */ -EXTERN int TclResetCancellation(Tcl_Interp *interp, int force); +TCLAPI int TclResetCancellation(Tcl_Interp *interp, int force); /* 238 */ -EXTERN int TclNRInterpProc(ClientData clientData, +TCLAPI int TclNRInterpProc(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 239 */ -EXTERN int TclNRInterpProcCore(Tcl_Interp *interp, +TCLAPI int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 240 */ -EXTERN int TclNRRunCallbacks(Tcl_Interp *interp, int result, +TCLAPI int TclNRRunCallbacks(Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 241 */ -EXTERN int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, +TCLAPI int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 242 */ -EXTERN int TclNREvalObjv(Tcl_Interp *interp, int objc, +TCLAPI int TclNREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 243 */ -EXTERN void TclDbDumpActiveObjects(FILE *outFile); +TCLAPI void TclDbDumpActiveObjects(FILE *outFile); /* 244 */ -EXTERN Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); +TCLAPI Tcl_HashTable * TclGetNamespaceChildTable(Tcl_Namespace *nsPtr); /* 245 */ -EXTERN Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); +TCLAPI Tcl_HashTable * TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr); /* 246 */ -EXTERN int TclInitRewriteEnsemble(Tcl_Interp *interp, +TCLAPI int TclInitRewriteEnsemble(Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 247 */ -EXTERN void TclResetRewriteEnsemble(Tcl_Interp *interp, +TCLAPI void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble); /* 248 */ -EXTERN int TclCopyChannel(Tcl_Interp *interp, +TCLAPI int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 249 */ -EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, +TCLAPI char * TclDoubleDigits(double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 250 */ -EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, +TCLAPI void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); typedef struct TclIntStubs { @@ -623,7 +601,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 */ - int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */ + void (*reserved8)(void); 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 */ @@ -657,7 +635,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 */ - CONST86 char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ + const 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 */ @@ -668,7 +646,7 @@ typedef struct TclIntStubs { void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); - int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */ + int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); @@ -692,7 +670,7 @@ typedef struct TclIntStubs { void (*tclpFree) (char *ptr); /* 74 */ unsigned long (*tclpGetClicks) (void); /* 75 */ unsigned long (*tclpGetSeconds) (void); /* 76 */ - void (*tclpGetTime) (Tcl_Time *time); /* 77 */ + void (*reserved77)(void); void (*reserved78)(void); void (*reserved79)(void); void (*reserved80)(void); @@ -716,10 +694,10 @@ typedef struct TclIntStubs { int (*tclServiceIdle) (void); /* 98 */ void (*reserved99)(void); void (*reserved100)(void); - CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */ + const 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 */ - int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */ + void (*reserved104)(void); void (*reserved105)(void); void (*reserved106)(void); void (*reserved107)(void); @@ -748,15 +726,15 @@ typedef struct TclIntStubs { 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 */ - struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */ + void (*reserved133)(void); void (*reserved134)(void); void (*reserved135)(void); void (*reserved136)(void); void (*reserved137)(void); - CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ + const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ void (*reserved139)(void); void (*reserved140)(void); - CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ + const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ @@ -797,8 +775,8 @@ typedef struct TclIntStubs { Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ void (*reserved180)(void); void (*reserved181)(void); - struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */ - struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */ + void (*reserved182)(void); + void (*reserved183)(void); void (*reserved184)(void); void (*reserved185)(void); void (*reserved186)(void); @@ -851,7 +829,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 (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */ + void (*reserved236)(void); 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 */ @@ -894,8 +872,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupCommand) /* 6 */ #define TclCopyAndCollapse \ (tclIntStubsPtr->tclCopyAndCollapse) /* 7 */ -#define TclCopyChannelOld \ - (tclIntStubsPtr->tclCopyChannelOld) /* 8 */ +/* Slot 8 is reserved */ #define TclCreatePipeline \ (tclIntStubsPtr->tclCreatePipeline) /* 9 */ #define TclCreateProc \ @@ -1002,8 +979,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpGetClicks) /* 75 */ #define TclpGetSeconds \ (tclIntStubsPtr->tclpGetSeconds) /* 76 */ -#define TclpGetTime \ - (tclIntStubsPtr->tclpGetTime) /* 77 */ +/* Slot 77 is reserved */ /* Slot 78 is reserved */ /* Slot 79 is reserved */ /* Slot 80 is reserved */ @@ -1042,8 +1018,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSetupEnv) /* 102 */ #define TclSockGetPort \ (tclIntStubsPtr->tclSockGetPort) /* 103 */ -#define TclSockMinimumBuffersOld \ - (tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */ +/* Slot 104 is reserved */ /* Slot 105 is reserved */ /* Slot 106 is reserved */ /* Slot 107 is reserved */ @@ -1097,8 +1072,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */ #define TclpHasSockets \ (tclIntStubsPtr->tclpHasSockets) /* 132 */ -#define TclpGetDate \ - (tclIntStubsPtr->tclpGetDate) /* 133 */ +/* Slot 133 is reserved */ /* Slot 134 is reserved */ /* Slot 135 is reserved */ /* Slot 136 is reserved */ @@ -1183,10 +1157,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ /* Slot 180 is reserved */ /* Slot 181 is reserved */ -#define TclpLocaltime \ - (tclIntStubsPtr->tclpLocaltime) /* 182 */ -#define TclpGmtime \ - (tclIntStubsPtr->tclpGmtime) /* 183 */ +/* Slot 182 is reserved */ +/* Slot 183 is reserved */ /* Slot 184 is reserved */ /* Slot 185 is reserved */ /* Slot 186 is reserved */ @@ -1267,8 +1239,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclVarHashCreateVar) /* 234 */ #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ -#define TclBackgroundException \ - (tclIntStubsPtr->tclBackgroundException) /* 236 */ +/* Slot 236 is reserved */ #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ #define TclNRInterpProc \ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index dcf1753..f7eb442 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -18,17 +18,6 @@ # define DIR void #endif -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -43,40 +32,38 @@ #if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */ /* 0 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, +TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 1 */ -EXTERN int TclpCloseFile(TclFile file); +TCLAPI int TclpCloseFile(TclFile file); /* 2 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, +TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, +TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* Slot 5 is reserved */ /* 6 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); +TCLAPI TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +TCLAPI TclFile TclpCreateTempFile(const char *contents); /* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); +TCLAPI Tcl_DirEntry * TclpReaddir(DIR *dir); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ /* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI char * TclpInetNtoa(struct in_addr addr); /* 14 */ -EXTERN int TclUnixCopyFile(const char *src, const char *dst, +TCLAPI int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* Slot 15 is reserved */ @@ -94,144 +81,141 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst, /* Slot 27 is reserved */ /* Slot 28 is reserved */ /* 29 */ -EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +TCLAPI int TclWinCPUID(unsigned int index, unsigned int *regs); /* 30 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, +TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN void TclWinConvertError(DWORD errCode); -/* 1 */ -EXTERN void TclWinConvertWSAError(DWORD errCode); +TCLAPI void TclWinConvertError(DWORD errCode); +/* Slot 1 is reserved */ /* 2 */ -EXTERN struct servent * TclWinGetServByName(const char *nm, +TCLAPI struct servent * TclWinGetServByName(const char *nm, const char *proto); /* 3 */ -EXTERN int TclWinGetSockOpt(SOCKET s, int level, int optname, +TCLAPI int TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval, int *optlen); /* 4 */ -EXTERN HINSTANCE TclWinGetTclInstance(void); +TCLAPI HINSTANCE TclWinGetTclInstance(void); /* 5 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); /* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +TCLAPI unsigned short TclWinNToHS(unsigned short ns); /* 7 */ -EXTERN int TclWinSetSockOpt(SOCKET s, int level, int optname, +TCLAPI int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen); /* 8 */ -EXTERN int TclpGetPid(Tcl_Pid pid); +TCLAPI int TclpGetPid(Tcl_Pid pid); /* 9 */ -EXTERN int TclWinGetPlatformId(void); +TCLAPI int TclWinGetPlatformId(void); /* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +TCLAPI Tcl_DirEntry * TclpReaddir(DIR *dir); /* 11 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, +TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 12 */ -EXTERN int TclpCloseFile(TclFile file); +TCLAPI int TclpCloseFile(TclFile file); /* 13 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, +TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 14 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 15 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, +TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 16 */ -EXTERN int TclpIsAtty(int fd); +TCLAPI int TclpIsAtty(int fd); /* 17 */ -EXTERN int TclUnixCopyFile(const char *src, const char *dst, +TCLAPI int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 18 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 19 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); +TCLAPI TclFile TclpOpenFile(const char *fname, int mode); /* 20 */ -EXTERN void TclWinAddProcess(HANDLE hProcess, DWORD id); +TCLAPI void TclWinAddProcess(HANDLE hProcess, DWORD id); /* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI char * TclpInetNtoa(struct in_addr addr); /* 22 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +TCLAPI TclFile TclpCreateTempFile(const char *contents); /* Slot 23 is reserved */ /* 24 */ -EXTERN char * TclWinNoBackslash(char *path); +TCLAPI char * TclWinNoBackslash(char *path); /* Slot 25 is reserved */ /* 26 */ -EXTERN void TclWinSetInterfaces(int wide); +TCLAPI void TclWinSetInterfaces(int wide); /* 27 */ -EXTERN void TclWinFlushDirtyChannels(void); +TCLAPI void TclWinFlushDirtyChannels(void); /* 28 */ -EXTERN void TclWinResetInterfaces(void); +TCLAPI void TclWinResetInterfaces(void); /* 29 */ -EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +TCLAPI int TclWinCPUID(unsigned int index, unsigned int *regs); /* 30 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, +TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN void TclGetAndDetachPids(Tcl_Interp *interp, +TCLAPI void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan); /* 1 */ -EXTERN int TclpCloseFile(TclFile file); +TCLAPI int TclpCloseFile(TclFile file); /* 2 */ -EXTERN Tcl_Channel TclpCreateCommandChannel(TclFile readFile, +TCLAPI Tcl_Channel TclpCreateCommandChannel(TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 3 */ -EXTERN int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); +TCLAPI int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe); /* 4 */ -EXTERN int TclpCreateProcess(Tcl_Interp *interp, int argc, +TCLAPI int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* Slot 5 is reserved */ /* 6 */ -EXTERN TclFile TclpMakeFile(Tcl_Channel channel, int direction); +TCLAPI TclFile TclpMakeFile(Tcl_Channel channel, int direction); /* 7 */ -EXTERN TclFile TclpOpenFile(const char *fname, int mode); +TCLAPI TclFile TclpOpenFile(const char *fname, int mode); /* 8 */ -EXTERN int TclUnixWaitForFile(int fd, int mask, int timeout); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); /* 9 */ -EXTERN TclFile TclpCreateTempFile(const char *contents); +TCLAPI TclFile TclpCreateTempFile(const char *contents); /* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); -/* 11 */ -EXTERN struct tm * TclpLocaltime_unix(const time_t *clock); -/* 12 */ -EXTERN struct tm * TclpGmtime_unix(const time_t *clock); +TCLAPI Tcl_DirEntry * TclpReaddir(DIR *dir); +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ /* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI char * TclpInetNtoa(struct in_addr addr); /* 14 */ -EXTERN int TclUnixCopyFile(const char *src, const char *dst, +TCLAPI int TclUnixCopyFile(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 15 */ -EXTERN int TclMacOSXGetFileAttribute(Tcl_Interp *interp, +TCLAPI int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 16 */ -EXTERN int TclMacOSXSetFileAttribute(Tcl_Interp *interp, +TCLAPI int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 17 */ -EXTERN int TclMacOSXCopyFileAttributes(const char *src, +TCLAPI int TclMacOSXCopyFileAttributes(const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 18 */ -EXTERN int TclMacOSXMatchType(Tcl_Interp *interp, +TCLAPI int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 19 */ -EXTERN void TclMacOSXNotifierAddRunLoopMode( +TCLAPI void TclMacOSXNotifierAddRunLoopMode( const void *runLoopMode); /* Slot 20 is reserved */ /* Slot 21 is reserved */ @@ -243,9 +227,9 @@ EXTERN void TclMacOSXNotifierAddRunLoopMode( /* Slot 27 is reserved */ /* Slot 28 is reserved */ /* 29 */ -EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs); +TCLAPI int TclWinCPUID(unsigned int index, unsigned int *regs); /* 30 */ -EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, +TCLAPI int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); #endif /* MACOSX */ @@ -266,8 +250,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ + void (*reserved11)(void); + void (*reserved12)(void); 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); @@ -289,7 +273,7 @@ typedef struct TclIntPlatStubs { #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ void (*tclWinConvertError) (DWORD errCode); /* 0 */ - void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */ + void (*reserved1)(void); 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 */ @@ -332,8 +316,8 @@ typedef struct TclIntPlatStubs { int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ + void (*reserved11)(void); + void (*reserved12)(void); 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 */ @@ -391,10 +375,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ @@ -421,8 +403,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ #define TclWinConvertError \ (tclIntPlatStubsPtr->tclWinConvertError) /* 0 */ -#define TclWinConvertWSAError \ - (tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */ +/* Slot 1 is reserved */ #define TclWinGetServByName \ (tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */ #define TclWinGetSockOpt \ @@ -502,10 +483,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ #define TclpReaddir \ (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #define TclUnixCopyFile \ @@ -539,13 +518,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT -#undef TclpLocaltime_unix -#undef TclpGmtime_unix -#undef TclWinConvertWSAError -#define TclWinConvertWSAError TclWinConvertError - #if defined(__WIN32__) || defined(__CYGWIN__) # undef TclWinNToHS # define TclWinNToHS ntohs diff --git a/generic/tclLoad.c b/generic/tclLoad.c index 5cacab1..75e513d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -463,13 +463,23 @@ Tcl_LoadObjCmd( } code = pkgPtr->initProc(target); } - /* * Test for whether the initialization failed. If so, transfer the error * from the target interpreter to the originating one. */ if (code != TCL_OK) { + Interp *iPtr = (Interp *) target; + if (iPtr->legacyResult && !iPtr->legacyFreeProc) { + /* + * 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_TransferResult(target, code, interp); goto done; } diff --git a/generic/tclMain.c b/generic/tclMain.c index f445383..73989ef 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -243,7 +243,7 @@ Tcl_SourceRCFile( const char *fileName; Tcl_Channel chan; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; @@ -263,14 +263,18 @@ Tcl_SourceRCFile( c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != NULL) { + Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1); + Tcl_Close(NULL, c); - if (Tcl_EvalFile(interp, fullName) != TCL_OK) { + Tcl_IncrRefCount(fullNameObj); + if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) { chan = Tcl_GetStdChannel(TCL_STDERR); if (chan) { Tcl_WriteObj(chan, Tcl_GetObjResult(interp)); Tcl_WriteChars(chan, "\n", 1); } } + Tcl_DecrRefCount(fullNameObj); } } Tcl_DStringFree(&temp); diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index e9b92fe..4e6f29fa 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -10,17 +10,6 @@ #ifndef _TCLPLATDECLS #define _TCLPLATDECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -48,19 +37,19 @@ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ /* 0 */ -EXTERN TCHAR * Tcl_WinUtfToTChar(const char *str, int len, +TCLAPI TCHAR * Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr); /* 1 */ -EXTERN char * Tcl_WinTCharToUtf(const TCHAR *str, int len, +TCLAPI char * Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr); #endif /* WIN */ #ifdef MAC_OSX_TCL /* MACOSX */ /* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, +TCLAPI int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */ -EXTERN int Tcl_MacOSXOpenVersionedBundleResources( +TCLAPI int Tcl_MacOSXOpenVersionedBundleResources( Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, @@ -112,9 +101,6 @@ extern const TclPlatStubs *tclPlatStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLPLATDECLS */ diff --git a/generic/tclResult.c b/generic/tclResult.c index 07f6819..5329e14 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -27,7 +27,6 @@ enum returnKeys { static Tcl_Obj ** GetKeys(void); static void ReleaseKeys(ClientData clientData); static void ResetObjResult(Interp *iPtr); -static void SetupAppendBuffer(Interp *iPtr, int newSpace); /* * This structure is used to take a snapshot of the interpreter state in @@ -246,44 +245,6 @@ Tcl_SaveResult( 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; } /* @@ -314,39 +275,6 @@ 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. */ @@ -377,14 +305,6 @@ Tcl_DiscardResult( Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ { 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); - } } /* @@ -414,49 +334,15 @@ Tcl_SetResult( * TCL_STATIC, TCL_VOLATILE, or the address of * a Tcl_FreeProc such as free. */ { - 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 { - iPtr->result = (char *) result; - iPtr->freeProc = freeProc; + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); + if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) { + return; } - - /* - * 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); - } + if (freeProc == TCL_DYNAMIC) { + ckfree(result); + } else { + (*freeProc)(result); } - - /* - * Reset the object result since we just set the string result. - */ - - ResetObjResult(iPtr); } /* @@ -480,18 +366,9 @@ const char * Tcl_GetStringResult( register Tcl_Interp *interp)/* Interpreter whose result to return. */ { - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - Interp *iPtr = (Interp *) interp; - if (*(iPtr->result) == 0) { - Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)), - TCL_VOLATILE); - } - return iPtr->result; + return Tcl_GetString(iPtr->objResultPtr); } /* @@ -532,21 +409,6 @@ Tcl_SetObjResult( */ TclDecrRefCount(oldObjResult); - - /* - * 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; } /* @@ -575,32 +437,7 @@ Tcl_GetObjResult( Tcl_Interp *interp) /* Interpreter whose result to return. */ { register Interp *iPtr = (Interp *) interp; - Tcl_Obj *objResultPtr; - int length; - - /* - * If the string result is non-empty, move the string result to the object - * result, then reset the string result. - */ - if (iPtr->result[0] != 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; - } return iPtr->objResultPtr; } @@ -637,23 +474,6 @@ Tcl_AppendResultVA( } Tcl_AppendStringsToObjVA(objPtr, argList); Tcl_SetObjResult(interp, objPtr); - - /* - * Strictly we should call Tcl_GetStringResult(interp) here to make sure - * that interp->result is correct according to the old contract, but that - * makes the performance of much code (e.g. in Tk) absolutely awful. So we - * leave it out; code that really wants interp->result can just insert the - * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion] - */ - -#ifdef USE_INTERP_RESULT - /* - * Ensure that the interp->result is legal so old Tcl 7.* code still - * works. There's still embarrasingly much of it about... - */ - - (void) Tcl_GetStringResult(interp); -#endif /* USE_INTERP_RESULT */ } /* @@ -719,129 +539,20 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; - char *dst; - int size; - int flags; - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (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); -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - *---------------------------------------------------------------------- - */ - -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_Obj *elementPtr = Tcl_NewStringObj(element, -1); + Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); + int length; + const char *bytes; + + if (Tcl_IsShared(iPtr->objResultPtr)) { + Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); + } + bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length); + if (TclNeedSpace(bytes, bytes+length)) { + Tcl_AppendToObj(iPtr->objResultPtr, " ", 1); } - - Tcl_FreeResult((Tcl_Interp *) iPtr); - iPtr->result = iPtr->appendResult; + Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr); + Tcl_DecrRefCount(listPtr); } /* @@ -850,18 +561,17 @@ SetupAppendBuffer( * Tcl_FreeResult -- * * This function frees up the memory associated with an interpreter's - * string result. It also resets the interpreter's result object. - * Tcl_FreeResult is most commonly used when a function is about to - * replace one result value with another. + * 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. * * Results: * None. * * Side effects: - * Frees the memory associated with interp's string result and sets - * interp->freeProc to zero, but does not change interp->result or clear - * error state. Resets interp's result object to an unshared empty - * object. + * 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). * *---------------------------------------------------------------------- */ @@ -872,15 +582,6 @@ Tcl_FreeResult( { register Interp *iPtr = (Interp *) interp; - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - ckfree(iPtr->result); - } else { - iPtr->freeProc(iPtr->result); - } - iPtr->freeProc = 0; - } - ResetObjResult(iPtr); } @@ -910,16 +611,6 @@ Tcl_ResetResult( register Interp *iPtr = (Interp *) interp; ResetObjResult(iPtr); - 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; if (iPtr->errorCode) { /* Legacy support */ if (iPtr->flags & ERR_LEGACY_COPY) { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 2d534a68..2287a16 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -18,13 +18,6 @@ #include <math.h> /* - * Define KILL_OCTAL to suppress interpretation of numbers with leading zero - * as octal. (Ceterum censeo: numeros octonarios delendos esse.) - */ - -#undef KILL_OCTAL - -/* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be * uniquely determined by radix and by the widths of significand and exponent. @@ -487,7 +480,7 @@ TclParseNumber( enum State { INITIAL, SIGNUM, ZERO, ZERO_X, ZERO_O, ZERO_B, BINARY, - HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL, + HEXADECIMAL, OCTAL, DECIMAL, LEADING_RADIX_POINT, FRACTION, EXPONENT_START, EXPONENT_SIGNUM, EXPONENT, sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY @@ -532,7 +525,6 @@ 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) @@ -644,14 +636,10 @@ TclParseNumber( goto zerob; } if (c == 'o' || c == 'O') { - explicitOctal = 1; state = ZERO_O; break; } -#ifdef KILL_OCTAL goto decimal; -#endif - /* FALLTHROUGH */ case OCTAL: /* @@ -714,58 +702,6 @@ 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 KILL_OCTAL - - /* - * 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; /* @@ -870,9 +806,7 @@ TclParseNumber( * digits. */ -#ifdef KILL_OCTAL decimal: -#endif acceptState = state; acceptPoint = p; acceptLen = len; @@ -1156,7 +1090,6 @@ TclParseNumber( TclFreeIntRep(objPtr); switch (acceptState) { case SIGNUM: - case BAD_OCTAL: case ZERO_X: case ZERO_O: case ZERO_B: @@ -1381,9 +1314,6 @@ 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); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1dbdc09..2881644 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -41,19 +41,6 @@ #undef Tcl_FindExecutable #undef TclpGetPid #undef TclSockMinimumBuffers -#define TclBackgroundException Tcl_BackgroundException - -/* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#ifdef _WIN64 -# define TclSockMinimumBuffersOld 0 -#else -#define TclSockMinimumBuffersOld sockMinimumBuffersOld -static int TclSockMinimumBuffersOld(int sock, int size) -{ - return TclSockMinimumBuffers(INT2PTR(sock), size); -} -#endif - #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) { @@ -196,9 +183,6 @@ Tcl_WinTCharToUtf( string, len, dsPtr); } -#else /* UNIX and MAC */ -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime #endif /* @@ -223,7 +207,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -292,7 +276,7 @@ static const TclIntStubs tclIntStubs = { TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - TclpGetTime, /* 77 */ + 0, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ @@ -319,7 +303,7 @@ static const TclIntStubs tclIntStubs = { TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -348,7 +332,7 @@ static const TclIntStubs tclIntStubs = { Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - TclpGetDate, /* 133 */ + 0, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -397,8 +381,8 @@ static const TclIntStubs tclIntStubs = { Tcl_GetStartupScript, /* 179 */ 0, /* 180 */ 0, /* 181 */ - TclpLocaltime, /* 182 */ - TclpGmtime, /* 183 */ + 0, /* 182 */ + 0, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -451,7 +435,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -483,8 +467,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ + 0, /* 11 */ + 0, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ 0, /* 15 */ @@ -506,7 +490,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ + 0, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ @@ -549,8 +533,8 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ + 0, /* 11 */ + 0, /* 12 */ TclpInetNtoa, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ @@ -756,7 +740,7 @@ const TclStubs tclStubs = { Tcl_AsyncMark, /* 74 */ Tcl_AsyncReady, /* 75 */ Tcl_BackgroundError, /* 76 */ - Tcl_Backslash, /* 77 */ + 0, /* 77 */ Tcl_BadChannelOption, /* 78 */ Tcl_CallWhenDeleted, /* 79 */ Tcl_CancelIdleCall, /* 80 */ @@ -774,7 +758,7 @@ const TclStubs tclStubs = { Tcl_CreateEventSource, /* 92 */ Tcl_CreateExitHandler, /* 93 */ Tcl_CreateInterp, /* 94 */ - Tcl_CreateMathFunc, /* 95 */ + 0, /* 95 */ Tcl_CreateObjCommand, /* 96 */ Tcl_CreateSlave, /* 97 */ Tcl_CreateTimerHandler, /* 98 */ @@ -809,7 +793,7 @@ const TclStubs tclStubs = { Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ Tcl_Eval, /* 129 */ - Tcl_EvalFile, /* 130 */ + 0, /* 130 */ Tcl_EvalObj, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ @@ -823,7 +807,7 @@ const TclStubs tclStubs = { Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ - Tcl_FindExecutable, /* 144 */ + 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ Tcl_FreeResult, /* 147 */ @@ -864,8 +848,8 @@ const TclStubs tclStubs = { Tcl_GetStringResult, /* 174 */ Tcl_GetVar, /* 175 */ Tcl_GetVar2, /* 176 */ - Tcl_GlobalEval, /* 177 */ - Tcl_GlobalEvalObj, /* 178 */ + 0, /* 177 */ + 0, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ @@ -907,7 +891,7 @@ const TclStubs tclStubs = { Tcl_ResetResult, /* 217 */ Tcl_ScanElement, /* 218 */ Tcl_ScanCountedElement, /* 219 */ - Tcl_SeekOld, /* 220 */ + 0, /* 220 */ Tcl_ServiceAll, /* 221 */ Tcl_ServiceEvent, /* 222 */ Tcl_SetAssocData, /* 223 */ @@ -933,7 +917,7 @@ const TclStubs tclStubs = { Tcl_SplitPath, /* 243 */ Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ + 0, /* 246 */ Tcl_TraceVar, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ @@ -1028,8 +1012,8 @@ const TclStubs tclStubs = { Tcl_WriteChars, /* 338 */ Tcl_WriteObj, /* 339 */ Tcl_GetString, /* 340 */ - Tcl_GetDefaultEncodingDir, /* 341 */ - Tcl_SetDefaultEncodingDir, /* 342 */ + 0, /* 341 */ + 0, /* 342 */ Tcl_AlertNotifier, /* 343 */ Tcl_ServiceModeHook, /* 344 */ Tcl_UniCharIsAlnum, /* 345 */ @@ -1044,7 +1028,7 @@ const TclStubs tclStubs = { Tcl_UniCharToUtfDString, /* 354 */ Tcl_UtfToUniCharDString, /* 355 */ Tcl_GetRegExpFromObj, /* 356 */ - Tcl_EvalTokens, /* 357 */ + 0, /* 357 */ Tcl_FreeParse, /* 358 */ Tcl_LogCommandInfo, /* 359 */ Tcl_ParseBraces, /* 360 */ @@ -1122,8 +1106,8 @@ const TclStubs tclStubs = { Tcl_AttemptSetObjLength, /* 432 */ Tcl_GetChannelThread, /* 433 */ Tcl_GetUnicodeFromObj, /* 434 */ - Tcl_GetMathFuncInfo, /* 435 */ - Tcl_ListMathFuncs, /* 436 */ + 0, /* 435 */ + 0, /* 436 */ Tcl_SubstObj, /* 437 */ Tcl_DetachChannel, /* 438 */ Tcl_IsStandardChannel, /* 439 */ diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index 859cbf9..47eefc3 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -35,7 +35,7 @@ static int isDigit(const int c) /* *---------------------------------------------------------------------- * - * Tcl_InitStubs -- + * TclInitStubs -- * * Tries to initialise the stub table pointers and ensures that the * correct version of Tcl is loaded. @@ -51,10 +51,12 @@ static int isDigit(const int c) */ #undef Tcl_InitStubs MODULE_SCOPE const char * -Tcl_InitStubs( +TclInitStubs( Tcl_Interp *interp, const char *version, - int exact) + int exact, + const char *tclversion, + int magic) { Interp *iPtr = (Interp *) interp; const char *actualVersion = NULL; @@ -68,8 +70,9 @@ Tcl_InitStubs( */ if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) { - iPtr->result = "interpreter uses an incompatible stubs mechanism"; - iPtr->freeProc = TCL_STATIC; + iPtr->legacyResult = + "interpreter uses an incompatible stubs mechanism"; + iPtr->legacyFreeProc = 0; /* TCL_STATIC */ return NULL; } diff --git a/generic/tclTest.c b/generic/tclTest.c index 297fe4d..ef5a25a 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -43,16 +43,8 @@ * Declare external functions used in Windows tests. */ -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Tcltest_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT -EXTERN int Tcltest_Init(Tcl_Interp *interp); -EXTERN int Tcltest_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Tcltest_Init(Tcl_Interp *interp); +DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp); /* * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect @@ -117,13 +109,6 @@ typedef struct TclEncoding { } TclEncoding; /* - * The counter below is used to determine if the TestsaveresultFree routine - * was called for a result. - */ - -static int freeCount; - -/* * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands. */ @@ -295,12 +280,6 @@ static int TestlinkCmd(ClientData dummy, static int TestlocaleCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int TestMathFunc(ClientData clientData, - Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr); -static int TestMathFunc2(ClientData clientData, - Tcl_Interp *interp, Tcl_Value *args, - Tcl_Value *resultPtr); static int TestmainthreadCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetmainloopCmd(ClientData dummy, @@ -524,8 +503,6 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { - Tcl_ValueType t3ArgTypes[2]; - Tcl_Obj *listPtr; Tcl_Obj **objv; int objc, index; @@ -534,10 +511,10 @@ Tcltest_Init( "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } - if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) { + if (Tcl_TomMath_InitStubs(interp, TCL_VERSION) == NULL) { return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { @@ -666,8 +643,7 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); - Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); - Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); + Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, @@ -678,10 +654,6 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif - t3ArgTypes[0] = TCL_EITHER; - t3ArgTypes[1] = TCL_EITHER; - Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, - NULL); Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); @@ -1847,7 +1819,7 @@ TestdstringCmd( if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) { return TCL_ERROR; } - Tcl_DStringTrunc(&dstring, count); + Tcl_DStringSetLength(&dstring, count); } else if (strcmp(argv[1], "start") == 0) { if (argc != 2) { goto wrongNumArgs; @@ -1973,7 +1945,7 @@ EncodingToUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -2005,7 +1977,7 @@ EncodingFromUtfProc( TclEncoding *encodingPtr; encodingPtr = (TclEncoding *) clientData; - Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd); + Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL); len = strlen(Tcl_GetStringResult(encodingPtr->interp)); if (len > dstLen) { @@ -3303,144 +3275,6 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * - * TestMathFunc -- - * - * This is a user-defined math procedure to test out math procedures - * with no arguments. - * - * Results: - * A normal Tcl completion code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -static int -TestMathFunc( - ClientData clientData, /* Integer value to return. */ - Tcl_Interp *interp, /* Not used. */ - Tcl_Value *args, /* Not used. */ - Tcl_Value *resultPtr) /* Where to store result. */ -{ - resultPtr->type = TCL_INT; - resultPtr->intValue = PTR2INT(clientData); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestMathFunc2 -- - * - * This is a user-defined math procedure to test out math procedures - * that do have arguments, in this case 2. - * - * Results: - * A normal Tcl completion code. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - - /* ARGSUSED */ -static int -TestMathFunc2( - ClientData clientData, /* Integer value to return. */ - Tcl_Interp *interp, /* Used to report errors. */ - Tcl_Value *args, /* Points to an array of two Tcl_Value structs - * for the two arguments. */ - Tcl_Value *resultPtr) /* Where to store the result. */ -{ - int result = TCL_OK; - - /* - * Return the maximum of the two arguments with the correct type. - */ - - if (args[0].type == TCL_INT) { - int i0 = args[0].intValue; - - if (args[1].type == TCL_INT) { - int i1 = args[1].intValue; - - resultPtr->type = TCL_INT; - resultPtr->intValue = ((i0 > i1)? i0 : i1); - } else if (args[1].type == TCL_DOUBLE) { - double d0 = i0; - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - Tcl_WideInt w0 = Tcl_LongAsWide(i0); - Tcl_WideInt w1 = args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); - result = TCL_ERROR; - } - } else if (args[0].type == TCL_DOUBLE) { - double d0 = args[0].doubleValue; - - if (args[1].type == TCL_INT) { - double d1 = args[1].intValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_DOUBLE) { - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - double d1 = Tcl_WideAsDouble(args[1].wideValue); - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); - result = TCL_ERROR; - } - } else if (args[0].type == TCL_WIDE_INT) { - Tcl_WideInt w0 = args[0].wideValue; - - if (args[1].type == TCL_INT) { - Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue); - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else if (args[1].type == TCL_DOUBLE) { - double d0 = Tcl_WideAsDouble(w0); - double d1 = args[1].doubleValue; - - resultPtr->type = TCL_DOUBLE; - resultPtr->doubleValue = ((d0 > d1)? d0 : d1); - } else if (args[1].type == TCL_WIDE_INT) { - Tcl_WideInt w1 = args[1].wideValue; - - resultPtr->type = TCL_WIDE_INT; - resultPtr->wideValue = ((w0 > w1)? w0 : w1); - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC); - result = TCL_ERROR; - } - } else { - Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC); - result = TCL_ERROR; - } - return result; -} - -/* - *---------------------------------------------------------------------- - * * CleanupTestSetassocdataTests -- * * This function is called when an interpreter is deleted to clean @@ -4475,7 +4309,7 @@ TestfeventCmd( return TCL_ERROR; } if (interp2 != NULL) { - code = Tcl_GlobalEval(interp2, argv[2]); + code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL); Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2)); return code; } else { @@ -5029,7 +4863,6 @@ 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; @@ -5080,7 +4913,6 @@ TestsaveresultCmd( break; } - freeCount = 0; Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { @@ -5097,14 +4929,10 @@ TestsaveresultCmd( } switch ((enum options) index) { - case RESULT_DYNAMIC: { - int present = iPtr->freeProc == TestsaveresultFree; - int called = freeCount; - - Tcl_AppendElement(interp, called ? "called" : "notCalled"); - Tcl_AppendElement(interp, present ? "present" : "missing"); + case RESULT_DYNAMIC: + Tcl_AppendElement(interp, discard ? "called" : "notCalled"); + Tcl_AppendElement(interp, !discard ? "present" : "missing"); break; - } case RESULT_OBJECT: Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr ? "same" : "different"); @@ -5135,7 +4963,7 @@ static void TestsaveresultFree( char *blockPtr) { - freeCount++; + /* empty... */ } /* diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 8708f9a..38dd010 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -834,7 +834,7 @@ ThreadSend( if (threadId == Tcl_GetCurrentThread()) { Tcl_MutexUnlock(&threadMutex); - return Tcl_GlobalEval(interp, script); + return Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL); } /* @@ -1029,7 +1029,7 @@ ThreadEventProc( Tcl_Preserve(interp); Tcl_ResetResult(interp); Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script); - code = Tcl_GlobalEval(interp, threadEventPtr->script); + code = Tcl_EvalEx(interp, threadEventPtr->script, -1, TCL_EVAL_GLOBAL); Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index ea3abb1..2124378 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -19,7 +19,7 @@ library tcl interface tclTomMath # hooks {tclTomMathInt} -scspec EXTERN +scspec TCLAPI # Declare each of the functions in the Tcl tommath interface diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index ef22153..b6dec32 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -115,17 +115,6 @@ #define s_mp_sqr TclBN_s_mp_sqr #define s_mp_sub TclBN_s_mp_sub -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -139,142 +128,142 @@ */ /* 0 */ -EXTERN int TclBN_epoch(void); +TCLAPI int TclBN_epoch(void); /* 1 */ -EXTERN int TclBN_revision(void); +TCLAPI int TclBN_revision(void); /* 2 */ -EXTERN int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c); /* 3 */ -EXTERN int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c); +TCLAPI int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c); /* 4 */ -EXTERN int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_and(mp_int *a, mp_int *b, mp_int *c); /* 5 */ -EXTERN void TclBN_mp_clamp(mp_int *a); +TCLAPI void TclBN_mp_clamp(mp_int *a); /* 6 */ -EXTERN void TclBN_mp_clear(mp_int *a); +TCLAPI void TclBN_mp_clear(mp_int *a); /* 7 */ -EXTERN void TclBN_mp_clear_multi(mp_int *a, ...); +TCLAPI void TclBN_mp_clear_multi(mp_int *a, ...); /* 8 */ -EXTERN int TclBN_mp_cmp(const mp_int *a, const mp_int *b); +TCLAPI int TclBN_mp_cmp(const mp_int *a, const mp_int *b); /* 9 */ -EXTERN int TclBN_mp_cmp_d(const mp_int *a, mp_digit b); +TCLAPI int TclBN_mp_cmp_d(const mp_int *a, mp_digit b); /* 10 */ -EXTERN int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b); +TCLAPI int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b); /* 11 */ -EXTERN int TclBN_mp_copy(const mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_copy(const mp_int *a, mp_int *b); /* 12 */ -EXTERN int TclBN_mp_count_bits(const mp_int *a); +TCLAPI int TclBN_mp_count_bits(const mp_int *a); /* 13 */ -EXTERN int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, +TCLAPI int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 14 */ -EXTERN int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, +TCLAPI int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 15 */ -EXTERN int TclBN_mp_div_2(mp_int *a, mp_int *q); +TCLAPI int TclBN_mp_div_2(mp_int *a, mp_int *q); /* 16 */ -EXTERN int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, +TCLAPI int TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r); /* 17 */ -EXTERN int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r); +TCLAPI int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r); /* 18 */ -EXTERN void TclBN_mp_exch(mp_int *a, mp_int *b); +TCLAPI void TclBN_mp_exch(mp_int *a, mp_int *b); /* 19 */ -EXTERN int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c); +TCLAPI int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c); /* 20 */ -EXTERN int TclBN_mp_grow(mp_int *a, int size); +TCLAPI int TclBN_mp_grow(mp_int *a, int size); /* 21 */ -EXTERN int TclBN_mp_init(mp_int *a); +TCLAPI int TclBN_mp_init(mp_int *a); /* 22 */ -EXTERN int TclBN_mp_init_copy(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_init_copy(mp_int *a, mp_int *b); /* 23 */ -EXTERN int TclBN_mp_init_multi(mp_int *a, ...); +TCLAPI int TclBN_mp_init_multi(mp_int *a, ...); /* 24 */ -EXTERN int TclBN_mp_init_set(mp_int *a, mp_digit b); +TCLAPI int TclBN_mp_init_set(mp_int *a, mp_digit b); /* 25 */ -EXTERN int TclBN_mp_init_size(mp_int *a, int size); +TCLAPI int TclBN_mp_init_size(mp_int *a, int size); /* 26 */ -EXTERN int TclBN_mp_lshd(mp_int *a, int shift); +TCLAPI int TclBN_mp_lshd(mp_int *a, int shift); /* 27 */ -EXTERN int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r); +TCLAPI int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r); /* 28 */ -EXTERN int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r); +TCLAPI int TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r); /* 29 */ -EXTERN int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p); +TCLAPI int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p); /* 30 */ -EXTERN int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p); +TCLAPI int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p); /* 31 */ -EXTERN int TclBN_mp_mul_2(mp_int *a, mp_int *p); +TCLAPI int TclBN_mp_mul_2(mp_int *a, mp_int *p); /* 32 */ -EXTERN int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p); +TCLAPI int TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p); /* 33 */ -EXTERN int TclBN_mp_neg(const mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_neg(const mp_int *a, mp_int *b); /* 34 */ -EXTERN int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_or(mp_int *a, mp_int *b, mp_int *c); /* 35 */ -EXTERN int TclBN_mp_radix_size(mp_int *a, int radix, int *size); +TCLAPI int TclBN_mp_radix_size(mp_int *a, int radix, int *size); /* 36 */ -EXTERN int TclBN_mp_read_radix(mp_int *a, const char *str, +TCLAPI int TclBN_mp_read_radix(mp_int *a, const char *str, int radix); /* 37 */ -EXTERN void TclBN_mp_rshd(mp_int *a, int shift); +TCLAPI void TclBN_mp_rshd(mp_int *a, int shift); /* 38 */ -EXTERN int TclBN_mp_shrink(mp_int *a); +TCLAPI int TclBN_mp_shrink(mp_int *a); /* 39 */ -EXTERN void TclBN_mp_set(mp_int *a, mp_digit b); +TCLAPI void TclBN_mp_set(mp_int *a, mp_digit b); /* 40 */ -EXTERN int TclBN_mp_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_sqr(mp_int *a, mp_int *b); /* 41 */ -EXTERN int TclBN_mp_sqrt(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_sqrt(mp_int *a, mp_int *b); /* 42 */ -EXTERN int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c); /* 43 */ -EXTERN int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c); +TCLAPI int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c); /* 44 */ -EXTERN int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b); +TCLAPI int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b); /* 45 */ -EXTERN int TclBN_mp_to_unsigned_bin_n(mp_int *a, +TCLAPI int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b, unsigned long *outlen); /* 46 */ -EXTERN int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, +TCLAPI int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen); /* 47 */ -EXTERN int TclBN_mp_unsigned_bin_size(mp_int *a); +TCLAPI int TclBN_mp_unsigned_bin_size(mp_int *a); /* 48 */ -EXTERN int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_xor(mp_int *a, mp_int *b, mp_int *c); /* 49 */ -EXTERN void TclBN_mp_zero(mp_int *a); +TCLAPI void TclBN_mp_zero(mp_int *a); /* 50 */ -EXTERN void TclBN_reverse(unsigned char *s, int len); +TCLAPI void TclBN_reverse(unsigned char *s, int len); /* 51 */ -EXTERN int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, +TCLAPI int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs); /* 52 */ -EXTERN int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b); /* 53 */ -EXTERN int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, +TCLAPI int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c); /* 54 */ -EXTERN int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b); /* 55 */ -EXTERN int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c); /* 56 */ -EXTERN int TclBN_mp_toom_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_mp_toom_sqr(mp_int *a, mp_int *b); /* 57 */ -EXTERN int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c); /* 58 */ -EXTERN int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, +TCLAPI int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs); /* 59 */ -EXTERN int TclBN_s_mp_sqr(mp_int *a, mp_int *b); +TCLAPI int TclBN_s_mp_sqr(mp_int *a, mp_int *b); /* 60 */ -EXTERN int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c); +TCLAPI int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c); /* 61 */ -EXTERN int TclBN_mp_init_set_int(mp_int *a, unsigned long i); +TCLAPI int TclBN_mp_init_set_int(mp_int *a, unsigned long i); /* 62 */ -EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i); +TCLAPI int TclBN_mp_set_int(mp_int *a, unsigned long i); /* 63 */ -EXTERN int TclBN_mp_cnt_lsb(const mp_int *a); +TCLAPI int TclBN_mp_cnt_lsb(const mp_int *a); typedef struct TclTomMathStubs { int magic; @@ -493,7 +482,4 @@ extern const TclTomMathStubs *tclTomMathStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - #endif /* _TCLINTDECLS */ diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 4b5b37b..93ab34b 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -107,7 +107,7 @@ static int UtfCount(int ch); *--------------------------------------------------------------------------- */ -INLINE static int +inline static int UtfCount( int ch) /* The Tcl_UniChar whose size is returned. */ { @@ -152,7 +152,7 @@ UtfCount( *--------------------------------------------------------------------------- */ -INLINE int +inline int Tcl_UniCharToUtf( int ch, /* The Tcl_UniChar to be stored in the * buffer. */ diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 27e2474..df257e8 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1556,40 +1556,6 @@ Tcl_Merge( /* *---------------------------------------------------------------------- * - * Tcl_Backslash -- - * - * Figure out how to handle a backslash sequence. - * - * Results: - * The return value is the character that should be substituted in place - * of the backslash sequence that starts at src. If readPtr isn't NULL - * then it is filled in with a count of the number of characters in the - * backslash sequence. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -char -Tcl_Backslash( - const char *src, /* Points to the backslash character of a - * backslash sequence. */ - int *readPtr) /* Fill in with number of characters read from - * src, unless NULL. */ -{ - char buf[TCL_UTF_MAX]; - Tcl_UniChar ch; - - Tcl_UtfBackslash(src, readPtr, buf); - TclUtfToUniChar(buf, &ch); - return (char) ch; -} - -/* - *---------------------------------------------------------------------- - * * TclTrimRight -- * * Takes two counted strings in the Tcl encoding which must both be null @@ -2796,7 +2762,6 @@ Tcl_DStringResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the * result of interp. */ { - Tcl_ResetResult(interp); Tcl_SetObjResult(interp, TclDStringToObj(dsPtr)); } @@ -2826,77 +2791,12 @@ Tcl_DStringGetResult( Tcl_DString *dsPtr) /* Dynamic string that is to become the result * of interp. */ { - Interp *iPtr = (Interp *) interp; - - if (dsPtr->string != dsPtr->staticSpace) { - ckfree(dsPtr->string); - } - - /* - * Do more efficient transfer when we know the result is a Tcl_Obj. When - * there's no st`ring result, we only have to deal with two cases: - * - * 1. When the string rep is the empty string, when we don't copy but - * instead use the staticSpace in the DString to hold an empty string. - - * 2. When the string rep is not there or there's a real string rep, when - * we use Tcl_GetString to fetch (or generate) the string rep - which - * we know to have been allocated with ckalloc() - and use it to - * populate the DString space. Then, we free the internal rep. and set - * the object's string representation back to the canonical empty - * string. - */ - - if (!iPtr->result[0] && iPtr->objResultPtr - && !Tcl_IsShared(iPtr->objResultPtr)) { - if (iPtr->objResultPtr->bytes == tclEmptyStringRep) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->string[0] = 0; - dsPtr->length = 0; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = Tcl_GetString(iPtr->objResultPtr); - dsPtr->length = iPtr->objResultPtr->length; - dsPtr->spaceAvl = dsPtr->length + 1; - TclFreeIntRep(iPtr->objResultPtr); - iPtr->objResultPtr->bytes = tclEmptyStringRep; - iPtr->objResultPtr->length = 0; - } - return; - } - - /* - * If the string result is empty, move the object result to the string - * result, then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); - - dsPtr->length = strlen(iPtr->result); - if (iPtr->freeProc != NULL) { - if (iPtr->freeProc == TCL_DYNAMIC) { - dsPtr->string = iPtr->result; - dsPtr->spaceAvl = dsPtr->length+1; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - iPtr->freeProc(iPtr->result); - } - dsPtr->spaceAvl = dsPtr->length+1; - iPtr->freeProc = NULL; - } else { - if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) { - dsPtr->string = dsPtr->staticSpace; - dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE; - } else { - dsPtr->string = ckalloc(dsPtr->length+1); - dsPtr->spaceAvl = dsPtr->length + 1; - } - memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1); - } + int length; + char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length); - iPtr->result = iPtr->resultSpace; - iPtr->resultSpace[0] = 0; + Tcl_DStringFree(dsPtr); + Tcl_DStringAppend(dsPtr, bytes, length); + Tcl_ResetResult(interp); } /* @@ -3548,7 +3448,6 @@ TclGetIntForIndex( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } @@ -3693,73 +3592,6 @@ SetEndOffsetFromAny( /* *---------------------------------------------------------------------- * - * TclCheckBadOctal -- - * - * This function checks for a bad octal value and appends a meaningful - * error to the interp's result. - * - * Results: - * 1 if the argument was a bad octal, else 0. - * - * Side effects: - * The interpreter's result is modified. - * - *---------------------------------------------------------------------- - */ - -int -TclCheckBadOctal( - Tcl_Interp *interp, /* Interpreter to use for error reporting. If - * NULL, then no error message is left after - * errors. */ - const char *value) /* String to check. */ -{ - register const char *p = value; - - /* - * A frequent mistake is invalid octal values due to an unwanted leading - * zero. Try to generate a meaningful error message. - */ - - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '+' || *p == '-') { - p++; - } - if (*p == '0') { - if ((p[1] == 'o') || p[1] == 'O') { - p += 2; - } - while (isdigit(UCHAR(*p))) { /* INTL: digit. */ - p++; - } - while (TclIsSpaceProc(*p)) { - p++; - } - if (*p == '\0') { - /* - * Reached end of string. - */ - - if (interp != NULL) { - /* - * Don't reset the result here because we want this result to - * be added to an existing error message as extra info. - */ - - Tcl_AppendToObj(Tcl_GetObjResult(interp), - " (looks like invalid octal number)", -1); - } - return 1; - } - } - return 0; -} - -/* - *---------------------------------------------------------------------- - * * ClearHash -- * * Remove all the entries in the hash table *tablePtr. @@ -4110,31 +3942,6 @@ Tcl_GetNameOfExecutable(void) /* *---------------------------------------------------------------------- * - * TclpGetTime -- - * - * Deprecated synonym for Tcl_GetTime. This function is provided for the - * benefit of extensions written before Tcl_GetTime was exported from the - * library. - * - * Results: - * None. - * - * Side effects: - * Stores current time in the buffer designated by "timePtr" - * - *---------------------------------------------------------------------- - */ - -void -TclpGetTime( - Tcl_Time *timePtr) -{ - Tcl_GetTime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * * TclGetPlatform -- * * This is a kludge that allows the test library to get access the diff --git a/generic/tclVar.c b/generic/tclVar.c index 2d1479d..1a81048 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -809,9 +809,6 @@ TclObjLookupVarEx( * - 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 AVOID_RESOLVERS 0x40000 diff --git a/library/http/http.tcl b/library/http/http.tcl index ddf066e..98066af 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles package provide http 2.8.6 diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index a8641e1..e4c0e11 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.6]} {return} +if {![package vsatisfies [package provide Tcl] 8.6-]} {return} package ifneeded http 2.8.6 [list tclPkgSetup $dir http 2.8.6 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index e836df9..7eeb53b 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6.0 +package require -exact Tcl 9.0a0 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 112507a..5f8e1e9 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 +package require Tcl 8.5- # When the version number changes, be sure to update the pkgIndex.tcl file, # and the installation directory in the Makefiles. package provide msgcat 1.5.0 diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 832bf81..a5b6499 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded msgcat 1.5.0 [list source [file join $dir msgcat.tcl]] diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl index fc77fa1..163bc7d 100644 --- a/library/opt/optparse.tcl +++ b/library/opt/optparse.tcl @@ -8,7 +8,7 @@ # on it. If your code does rely on this package you # may directly incorporate this code into your application. -package require Tcl 8.2 +package require Tcl 8.2- # When this version number changes, update the pkgIndex.tcl file # and the install directory in the Makefiles. package provide opt 0.4.6 diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl index 107d4c6..d96af94 100644 --- a/library/opt/pkgIndex.tcl +++ b/library/opt/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.2]} {return} +if {![package vsatisfies [package provide Tcl] 8.2-]} {return} package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]] diff --git a/library/package.tcl b/library/package.tcl index c30431c..5b99a69 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -137,6 +137,9 @@ proc pkg_mkIndex {args} { } on error {msg opt} { return -options $opt $msg } + if {[llength $fileList] == 0} { + return -code error "no files matched glob pattern \"$patternList\"" + } foreach file $fileList { # For each file, figure out what commands and packages it provides. # To do this, create a child interpreter, load the file into the diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 4b0a9bc..fabddb0 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -8,5 +8,5 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded tcltest 2.3.5 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 83ec9d3..07d0a51 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. -package require Tcl 8.5 ;# -verbose line uses [info frame] +package require Tcl 8.5- ;# -verbose line uses [info frame] namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig index 9c47547..6ee8d58 100644 --- a/macosx/Tcl-Common.xcconfig +++ b/macosx/Tcl-Common.xcconfig @@ -34,4 +34,4 @@ TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION) TCL_PACKAGE_PATH = "$(LIBDIR)" TCL_DEFS = HAVE_TCL_CONFIG_H -VERSION = 8.6 +VERSION = 9.0 diff --git a/tests/all.tcl b/tests/all.tcl index 05d3024..5fd21ce 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -11,7 +11,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package prefer latest -package require Tcl 8.5 +package require Tcl 8.5- package require tcltest 2.2 namespace import tcltest::* configure {*}$argv -testdir [file dir [info script]] diff --git a/tests/assemble.test b/tests/assemble.test index 7d4e5d1..48e87a1 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -782,7 +782,7 @@ test assemble-7.43 {uplus} { } } -returnCodes error - -result {can't use non-numeric floating-point value as operand of "+"} + -result {can't use non-numeric floating-point value "NaN" as operand of "+"} } test assemble-7.43.1 {tryCvtToNumeric} { -body { @@ -1364,10 +1364,10 @@ test assemble-12.6 {incr, stupid stack restriction} { set y 5 assemble {push 3; incr y} " - list [catch {x} result] $result $errorCode + x } - -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} - -cleanup {unset result; rename x {}} + -result 8 + -cleanup {rename x {}} } # assemble-13 -- ASSEM_LVT1_SINT1 - incrImm and incrArrayImm @@ -1455,10 +1455,10 @@ test assemble-13.9 {incrImm, stupid stack restriction} { set y 5 assemble {incrImm y 3} " - list [catch {x} result] $result $errorCode + x } - -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}} - -cleanup {unset result; rename x {}} + -result 8 + -cleanup {rename x {}} } # assemble-14 -- ASSEM_SINT1 (incrArrayStkImm and incrStkImm) diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index 6d63cea..0000000 --- a/tests/case.test +++ /dev/null @@ -1,89 +0,0 @@ -# Commands covered: case -# -# This file contains a collection of tests for one or more of the Tcl -# built-in commands. Sourcing this file into Tcl runs the tests and -# generates output for errors. No output means no errors were found. -# -# Copyright (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} - -test case-1.1 {simple pattern} { - case a in a {format 1} b {format 2} c {format 3} default {format 4} -} 1 -test case-1.2 {simple pattern} { - case b a {format 1} b {format 2} c {format 3} default {format 4} -} 2 -test case-1.3 {simple pattern} { - case x in a {format 1} b {format 2} c {format 3} default {format 4} -} 4 -test case-1.4 {simple pattern} { - case x a {format 1} b {format 2} c {format 3} -} {} -test case-1.5 {simple pattern matches many times} { - case b a {format 1} b {format 2} b {format 3} b {format 4} -} 2 -test case-1.6 {fancier pattern} { - case cx a {format 1} *c {format 2} *x {format 3} default {format 4} -} 3 -test case-1.7 {list of patterns} { - case abc in {a b c} {format 1} {def abc ghi} {format 2} -} 2 - -test case-2.1 {error in executed command} { - list [catch {case a in a {error "Just a test"} default {format 1}} msg] \ - $msg $::errorInfo -} {1 {Just a test} {Just a test - while executing -"error "Just a test"" - ("a" arm line 1) - invoked from within -"case a in a {error "Just a test"} default {format 1}"}} -test case-2.2 {error: not enough args} { - list [catch {case} msg] $msg -} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}} -test case-2.3 {error: pattern with no body} { - list [catch {case a b} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.4 {error: pattern with no body} { - list [catch {case a in b {format 1} c} msg] $msg -} {1 {extra case pattern with no body}} -test case-2.5 {error in default command} { - list [catch {case foo in a {error case1} default {error case2} \ - b {error case 3}} msg] $msg $::errorInfo -} {1 case2 {case2 - while executing -"error case2" - ("default" arm line 1) - invoked from within -"case foo in a {error case1} default {error case2} b {error case 3}"}} - -test case-3.1 {single-argument form for pattern/command pairs} { - case b in { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.2 {single-argument form for pattern/command pairs} { - case b { - a {format 1} - b {format 2} - default {format 6} - } -} {2} -test case-3.3 {single-argument form for pattern/command pairs} { - list [catch {case z in {a 2 b}} msg] $msg -} {1 {extra case pattern with no body}} - -# cleanup -::tcltest::cleanupTests -return diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 3051bfb..0517e5f 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -59,8 +59,6 @@ test cmdAH-0.2 {Tcl_BreakObjCmd, success} { list [catch {break} msg] $msg } {3 {}} -# Tcl_CaseObjCmd is tested in case.test - test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body { catch } -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bae26a0..774060d 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -18,13 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} # Big test for correct ordering of data in [expr] @@ -285,10 +278,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -309,10 +302,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1 test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1 @@ -377,10 +370,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test compExpr-old-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test compExpr-old-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -399,10 +392,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test compExpr-old-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test compExpr-old-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test compExpr-old-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -430,10 +423,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body } -returnCodes error -match glob -result * test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -451,10 +444,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test compExpr-old-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test compExpr-old-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -602,21 +595,6 @@ test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body { test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * -test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr 2*T1() -} 246 -test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T2()*3 -} 1035 -test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(21, 37) -} 37 -test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(21.2, 37) -} 37.0 -test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T3(-21.2, -17.5) -} -17.5 test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { catch {unset a} diff --git a/tests/compExpr.test b/tests/compExpr.test index 14c875d..a2a021e 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -14,13 +14,6 @@ if {"::tcltest" ni [namespace children]} { } ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} # Constrain memory leak tests testConstraint memory [llength [info commands memory]] @@ -319,12 +312,6 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { expr {do_it()} } -returnCodes error -match glob -result {* "*do_it"} -test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr 3*T1()-1 -} 368 -test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions { - expr T2()*3 -} 1035 test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body { expr {atan2(1.0)} } -returnCodes error -match glob -result {too few arguments for math function*} diff --git a/tests/compile.test b/tests/compile.test index 4d91940..d276460 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -282,7 +282,7 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { } -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?} test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; string index a 0o9 }} -} -returnCodes error -match glob -result {*invalid octal number*} +} -returnCodes error -match glob -result {*} test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body { apply {{} { set r [list foobar] ; array set var {one two many} }} } -returnCodes error -result {list must have an even number of elements} diff --git a/tests/execute.test b/tests/execute.test index 94af158..e0b68e5 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -174,7 +174,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x + 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 + $x} @@ -199,7 +199,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 + $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_SUB is partially tested: test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} { @@ -226,7 +226,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {$x - 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} { set x [testintobj set 0 1] expr {1 - $x} @@ -251,7 +251,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} { set x [teststringobj set 0 foo] list [catch {expr {1 - $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_MULT is partially tested: test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} { @@ -278,7 +278,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x * 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} { set x [testintobj set 1 1] expr {1 * $x} @@ -303,7 +303,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 * $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "foo" as operand of "*"}} # INST_DIV is partially tested: test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} { @@ -330,7 +330,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {$x / 1}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} { set x [testintobj set 1 1] expr {2 / $x} @@ -355,7 +355,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {1 / $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "foo" as operand of "/"}} # INST_UPLUS is partially tested: test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} { @@ -382,7 +382,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {+ $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "foo" as operand of "+"}} # INST_UMINUS is partially tested: test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} { @@ -409,7 +409,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {- $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "foo" as operand of "-"}} # INST_LNOT is partially tested: test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} { @@ -457,7 +457,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { set x [teststringobj set 1 foo] list [catch {expr {! $x}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "foo" as operand of "!"}} # INST_BITNOT not tested # INST_CALL_BUILTIN_FUNC1 not tested diff --git a/tests/expr-old.test b/tests/expr-old.test index 4f3cb2e..ed0f11f 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -26,12 +26,6 @@ testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] testConstraint longIs32bit [expr {int(0x80000000) < 0}] -if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} { - testConstraint testmathfunctions 0 -} else { - testConstraint testmathfunctions 1 -} - # Big test for correct ordering of data in [expr] proc testIEEE {} { @@ -199,34 +193,34 @@ test expr-old-2.38 {floating-point operators} { test expr-old-3.1 {illegal floating-point operations} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-old-3.2 {illegal floating-point operations} { list [catch {expr 27%4.0} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "4.0" as operand of "%"}} test expr-old-3.3 {illegal floating-point operations} { list [catch {expr 27.0%4} msg] $msg -} {1 {can't use floating-point value as operand of "%"}} +} {1 {can't use floating-point value "27.0" as operand of "%"}} test expr-old-3.4 {illegal floating-point operations} { list [catch {expr 1.0<<3} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.5 {illegal floating-point operations} { list [catch {expr 3<<1.0} msg] $msg -} {1 {can't use floating-point value as operand of "<<"}} +} {1 {can't use floating-point value "1.0" as operand of "<<"}} test expr-old-3.6 {illegal floating-point operations} { list [catch {expr 24.0>>3} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-old-3.7 {illegal floating-point operations} { list [catch {expr 24>>3.0} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "3.0" as operand of ">>"}} test expr-old-3.8 {illegal floating-point operations} { list [catch {expr 24&3.0} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "3.0" as operand of "&"}} test expr-old-3.9 {illegal floating-point operations} { list [catch {expr 24.0|3} msg] $msg -} {1 {can't use floating-point value as operand of "|"}} +} {1 {can't use floating-point value "24.0" as operand of "|"}} test expr-old-3.10 {illegal floating-point operations} { list [catch {expr 24.0^3} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} # Check the string operators individually. @@ -267,46 +261,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar test expr-old-5.1 {illegal string operations} { list [catch {expr {-"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.2 {illegal string operations} { list [catch {expr {+"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.3 {illegal string operations} { list [catch {expr {~"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "a" as operand of "~"}} test expr-old-5.4 {illegal string operations} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-old-5.5 {illegal string operations} { list [catch {expr {"a"*"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "a" as operand of "*"}} test expr-old-5.6 {illegal string operations} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-5.7 {illegal string operations} { list [catch {expr {"a"%"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "%"}} +} {1 {can't use non-numeric string "a" as operand of "%"}} test expr-old-5.8 {illegal string operations} { list [catch {expr {"a"+"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-5.9 {illegal string operations} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-old-5.10 {illegal string operations} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-old-5.11 {illegal string operations} { list [catch {expr {"a">>"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of ">>"}} +} {1 {can't use non-numeric string "a" as operand of ">>"}} test expr-old-5.12 {illegal string operations} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-old-5.13 {illegal string operations} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-old-5.14 {illegal string operations} { list [catch {expr {"a"|"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "|"}} +} {1 {can't use non-numeric string "a" as operand of "|"}} test expr-old-5.15 {illegal string operations} { list [catch {expr {"a"&&"b"}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -495,7 +489,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0 test expr-old-26.1 {error conditions} { list [catch {expr 2+"a"} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test expr-old-26.2 {error conditions} -body { expr 2+4* } -returnCodes error -match glob -result * @@ -509,10 +503,10 @@ test expr-old-26.4 {error conditions} { set a xx test expr-old-26.5 {error conditions} { list [catch {expr {2+$a}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.6 {error conditions} { list [catch {expr {2+[set a]}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-old-26.7 {error conditions} -body { expr {2+(4} } -returnCodes error -match glob -result * @@ -536,7 +530,7 @@ test expr-old-26.12 {error conditions} -body { } -returnCodes error -match glob -result * test expr-old-26.13 {error conditions} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-old-26.14 {error conditions} -body { expr 2:3 } -returnCodes error -match glob -result * @@ -849,12 +843,6 @@ test expr-old-32.41 {math functions in expressions} { test expr-old-32.42 {math functions in expressions} { list [catch {expr hypot(5*.8,3)} msg] $msg } {0 5.0} -test expr-old-32.43 {math functions in expressions} testmathfunctions { - expr 2*T1() -} 246 -test expr-old-32.44 {math functions in expressions} testmathfunctions { - expr T2()*3 -} 1035 test expr-old-32.45 {math functions in expressions} { expr (0 <= rand()) && (rand() < 1) } {1} @@ -954,10 +942,6 @@ test expr-old-34.15 {errors in math functions} { test expr-old-34.16 {errors in math functions} { expr round(-1.0e30) } -1000000000000000019884624838656 -test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \ - -body { - list [catch {expr T1(4)} msg] $msg - } -match glob -result {1 {too many arguments for math function*}} test expr-old-36.1 {ExprLooksLikeInt procedure} -body { expr 0o289 @@ -965,7 +949,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} -body { test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0o289 list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o289" as operand of "+"}} test expr-old-36.3 {ExprLooksLikeInt procedure} { list [catch {expr 0289.1} msg] $msg } {0 289.1} @@ -1005,11 +989,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} { test expr-old-36.12 {ExprLooksLikeInt procedure} { set x "10;" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "10;" as operand of "+"}} test expr-old-36.13 {ExprLooksLikeInt procedure} { set x " +" list [catch {expr {$x+1}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string " +" as operand of "+"}} test expr-old-36.14 {ExprLooksLikeInt procedure} { set x "123456789012345678901234567890 " expr {$x+1} @@ -1017,7 +1001,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} { test expr-old-36.15 {ExprLooksLikeInt procedure} { set x "0o99 " list [catch {expr {$x+1}} msg] $msg -} {1 {can't use invalid octal number as operand of "+"}} +} {1 {can't use non-numeric string "0o99 " as operand of "+"}} test expr-old-36.16 {ExprLooksLikeInt procedure} { set x " 0xffffffffffffffffffffffffffffffffffffff " expr {$x+1} diff --git a/tests/expr.test b/tests/expr.test index 6ad7208..29fb967 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -16,11 +16,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } ::tcltest::loadTestedCommands -catch [list package require -exact Tcltest [info patchlevel]] - -testConstraint testmathfunctions [expr { - ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"}) -}] # Determine if "long int" type is a 32 bit number and if the wide # type is a 64 bit number on this machine. @@ -257,7 +252,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} { } 1 test expr-4.10 {CompileLorExpr: error compiling ! operand} { list [catch {expr {!"a"}} msg] $msg -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "a" as operand of "!"}} test expr-4.11 {CompileLorExpr: error compiling land arms} { list [catch {expr {"a"||0}} msg] $msg } {1 {expected boolean value but got "a"}} @@ -304,10 +299,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body { } -returnCodes error -match glob -result * test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {24.0^3}} msg] $msg -} {1 {can't use floating-point value as operand of "^"}} +} {1 {can't use floating-point value "24.0" as operand of "^"}} test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} { list [catch {expr {"a"^"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "^"}} +} {1 {can't use non-numeric string "a" as operand of "^"}} test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0 test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1 @@ -328,10 +323,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body { } -returnCodes error -match glob -result * test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {24.0&3}} msg] $msg -} {1 {can't use floating-point value as operand of "&"}} +} {1 {can't use floating-point value "24.0" as operand of "&"}} test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} { list [catch {expr {"a"&"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "&"}} +} {1 {can't use non-numeric string "a" as operand of "&"}} test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body { @@ -456,10 +451,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body { } -returnCodes error -match glob -result * test expr-10.10 {CompileShiftExpr: runtime error} { list [catch {expr {24.0>>43}} msg] $msg -} {1 {can't use floating-point value as operand of ">>"}} +} {1 {can't use floating-point value "24.0" as operand of ">>"}} test expr-10.11 {CompileShiftExpr: runtime error} { list [catch {expr {"a"<<"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "<<"}} +} {1 {can't use non-numeric string "a" as operand of "<<"}} test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1 @@ -478,10 +473,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body { } -returnCodes error -match glob -result * test expr-11.10 {CompileAddExpr: runtime error} { list [catch {expr {24.0+"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "xx" as operand of "+"}} test expr-11.11 {CompileAddExpr: runtime error} { list [catch {expr {"a"-"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "-"}} +} {1 {can't use non-numeric string "a" as operand of "-"}} test expr-11.12 {CompileAddExpr: runtime error} { list [catch {expr {3/0}} msg] $msg } {1 {divide by zero}} @@ -509,10 +504,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body { } -returnCodes error -match glob -result * test expr-12.10 {CompileMultiplyExpr: runtime error} { list [catch {expr {24.0*"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "*"}} +} {1 {can't use non-numeric string "xx" as operand of "*"}} test expr-12.11 {CompileMultiplyExpr: runtime error} { list [catch {expr {"a"/"b"}} msg] $msg -} {1 {can't use non-numeric string as operand of "/"}} +} {1 {can't use non-numeric string "a" as operand of "/"}} test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255 test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83 @@ -529,10 +524,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body { } -returnCodes error -match glob -result * test expr-13.10 {CompileUnaryExpr: runtime error} { list [catch {expr {~"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "~"}} +} {1 {can't use non-numeric string "xx" as operand of "~"}} test expr-13.11 {CompileUnaryExpr: runtime error} { list [catch {expr ~4.0} msg] $msg -} {1 {can't use floating-point value as operand of "~"}} +} {1 {can't use floating-point value "4.0" as operand of "~"}} test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291 test expr-13.13 {CompileUnaryExpr: just primary expr} { set a 27 @@ -685,41 +680,6 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} -body { test expr-15.6 {CompileMathFuncCall: missing ')'} -body { expr sin(1 } -returnCodes error -match glob -result * -test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr 2*T1() -} 246 -test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T2()*3 -} 1035 -test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(21, 37) -} 37 -test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(21.2, 37) -} 37.0 -test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} { - expr T3(-21.2, -17.5) -} -17.5 -test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(21, wide(37)) -} 37 -test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), 37) -} 37 -test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), wide(37)) -} 37 -test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(21.0, wide(37)) -} 37.0 -test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} { - expr T3(wide(21), 37.0) -} 37.0 -test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints { - testmathfunctions -} -body { - expr T3(0,"a") -} -returnCodes error -result {argument to math function didn't have numeric value} test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} { @@ -844,15 +804,15 @@ test expr-21.13 {non-numeric boolean literals} -body { } -returnCodes error -match glob -result * test expr-21.14 {non-numeric boolean literals} { list [catch {expr !"truef"} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.15 {non-numeric boolean variables} { set v truef list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "truef" as operand of "!"}} test expr-21.16 {non-numeric boolean variables} { set v "true " list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "true " as operand of "!"}} test expr-21.17 {non-numeric boolean variables} { set v "tru" list [catch {expr {!$v}} err] $err @@ -872,23 +832,23 @@ test expr-21.20 {non-numeric boolean variables} { test expr-21.21 {non-numeric boolean variables} { set v "o" list [catch {expr {!$v}} err] $err -} {1 {can't use non-numeric string as operand of "!"}} +} {1 {can't use non-numeric string "o" as operand of "!"}} test expr-21.22 {non-numeric boolean variables} { set v "" list [catch {expr {!$v}} err] $err -} {1 {can't use empty string as operand of "!"}} +} {1 {can't use non-numeric string "" as operand of "!"}} # Test for non-numeric float handling. test expr-22.1 {non-numeric floats} { list [catch {expr {NaN + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.2 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {Inf + 1}} msg] $msg } {1 {can't use infinite floating-point value as operand of "+"}} test expr-22.3 {non-numeric floats} { set nan NaN list [catch {expr {$nan + 1}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "+"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}} test expr-22.4 {non-numeric floats} !ieeeFloatingPoint { set inf Inf list [catch {expr {$inf + 1}} msg] $msg @@ -901,7 +861,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint { } {1 {floating-point value too large to represent}} test expr-22.7 {non-numeric floats} { list [catch {expr {1 / NaN}} msg] $msg -} {1 {can't use non-numeric floating-point value as operand of "/"}} +} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}} test expr-22.8 {non-numeric floats} !ieeeFloatingPoint { list [catch {expr {1 / Inf}} msg] $msg } {1 {can't use infinite floating-point value as operand of "/"}} @@ -928,10 +888,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body { } -returnCodes error -match glob -result * test expr-23.9 {CompileExponentialExpr: runtime error} { list [catch {expr {24.0**"xx"}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "xx" as operand of "**"}} test expr-23.10 {CompileExponentialExpr: runtime error} { list [catch {expr {"a"**2}} msg] $msg -} {1 {can't use non-numeric string as operand of "**"}} +} {1 {can't use non-numeric string "a" as operand of "**"}} test expr-23.11 {CompileExponentialExpr: runtime error} { list [catch {expr {0**-1}} msg] $msg } {1 {exponentiation of zero by negative power}} diff --git a/tests/fCmd.test b/tests/fCmd.test index 325b374..9fae2c5 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.test @@ -745,12 +745,12 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup { } -result {bad option "-tf1": must be -force or --} test fCmd-7.5 {FileForceOption: multiple times through loop} -setup { cleanup -} -constraints {notRoot} -returnCodes error -body { +} -constraints {notRoot} -body { createfile -- createfile -force file delete -force -force -- -- -force glob -- -- -force -} -result {no files matched glob patterns "-- -force"} +} -result {} test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \ -constraints {unix notRoot knownBug} -body { @@ -938,9 +938,9 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup { testchmod 444 tf2 file rename tf1 [file join td1 tf3] file rename tf2 [file join td1 tf4] - list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \ + list [glob tf*] [lsort [glob -directory td1 t*]] \ [file writable [file join td1 tf3]] [file writable [file join td1 tf4]] -} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}] +} -result [subst {{} {[file join td1 tf3] [file join td1 tf4]} 1 0}] test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup { cleanup } -constraints {notRoot testchmod} -body { diff --git a/tests/fileName.test b/tests/fileName.test index 51f00d1..2dac0df 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -696,9 +696,9 @@ test filename-10.24 {Tcl_TranslateFileName} -body { testtranslatefilename ~ouster/foo } -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename} -test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body { +test filename-11.1 {Tcl_GlobCmd} -body { glob -} -result {no files matched glob patterns ""} +} -result {} test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body { glob -gorp } -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --} @@ -714,9 +714,9 @@ test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body { test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body { glob ~xyqrszzz } -result {user "xyqrszzz" doesn't exist} -test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body { +test filename-11.7 {Tcl_GlobCmd} -body { glob -- -nocomplain -} -result {no files matched glob pattern "-nocomplain"} +} -result {} test filename-11.8 {Tcl_GlobCmd} -body { glob -nocomplain -- -nocomplain } -result {} @@ -1085,7 +1085,7 @@ test filename-12.1 {simple globbing} {unixOrPc} { } {.} test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body { glob -types f {} -} -returnCodes error -result {no files matched glob pattern ""} +} -result {} test filename-12.1.2 {simple globbing} {unixOrPc} { glob -types d {} } {.} @@ -1247,10 +1247,10 @@ test filename-14.20 {asterisks, question marks, and brackets} { } {} test filename-14.21 {asterisks, question marks, and brackets} -body { glob globTest/*/gorp -} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"} +} -result {} test filename-14.22 {asterisks, question marks, and brackets} -body { glob goo/* x*z foo?q -} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"} +} -result {} test filename-14.23 {slash globbing} {unix} { glob / } / diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 9c543dc..9d0650e 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- proc ::tcl::dict::get? {dict key} { if {[dict exists $dict $key]} { diff --git a/tests/lindex.test b/tests/lindex.test index b86e2e0..81f5c40 100644 --- a/tests/lindex.test +++ b/tests/lindex.test @@ -70,11 +70,11 @@ test lindex-3.4 {integer 3} testevalex { test lindex-3.5 {bad octal} -constraints testevalex -body { set x 0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.6 {bad octal} -constraints testevalex -body { set x -0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-3.7 {indexes don't shimmer wide ints} { set x [expr {(wide(1)<<31) - 2}] list $x [lindex {1 2 3} $x] [incr x] [incr x] @@ -105,11 +105,11 @@ test lindex-4.5 {index = end-3} testevalex { test lindex-4.6 {bad octal} -constraints testevalex -body { set x end-0o8 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.7 {bad octal} -constraints testevalex -body { set x end--0o9 list [catch { testevalex {lindex {a b c} $x} } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-4.8 {bad integer, not octal} testevalex { set x end-0a2 list [catch { testevalex {lindex {a b c} $x} } result] $result @@ -261,11 +261,11 @@ test lindex-11.4 {integer 3} { test lindex-11.5 {bad octal} -body { set x 0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-11.6 {bad octal} -body { set x -0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} # Indices relative to end @@ -307,11 +307,11 @@ test lindex-12.5 {index = end-3} { test lindex-12.6 {bad octal} -body { set x end-0o8 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.7 {bad octal} -body { set x end--0o9 list [catch { lindex {a b c} $x } result] $result -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test lindex-12.8 {bad integer, not octal} { set x end-0a2 list [catch { lindex {a b c} $x } result] $result diff --git a/tests/main.test b/tests/main.test index f1dc7fd..7fd9d73 100644 --- a/tests/main.test +++ b/tests/main.test @@ -16,7 +16,7 @@ namespace eval ::tcl::test::main { # - tests use testing commands introduced in Tcltest 8.4 testConstraint Tcltest [expr { [llength [package provide Tcltest]] - && [package vsatisfies [package provide Tcltest] 8.4]}] + && [package vsatisfies [package provide Tcltest] 8.4-]}] # Procedure to simulate interactive typing of commands, line by line proc type {chan script} { diff --git a/tests/mathop.test b/tests/mathop.test index f122b7b..0808d42 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -114,22 +114,22 @@ namespace eval ::testmathop { test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.11 {compiled +: errors} -returnCodes error -body { + x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.12 {compiled +: errors} -returnCodes error -body { + nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.13 {compiled +: errors} -returnCodes error -body { + 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.14 {compiled +: errors} -returnCodes error -body { + 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.15 {compiled +: errors} -returnCodes error -body { + 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.16 {compiled +: errors} -returnCodes error -body { + 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.17 {compiled +: errors} -returnCodes error -body { + 0 [error expectedError] } -result expectedError @@ -152,22 +152,22 @@ namespace eval ::testmathop { test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003 test mathop-1.29 {interpreted +: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.30 {interpreted +: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.31 {interpreted +: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "+"} + } -result {can't use non-numeric string "x" as operand of "+"} test mathop-1.32 {interpreted +: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "+"} + } -result {can't use non-numeric floating-point value "nan" as operand of "+"} test mathop-1.33 {interpreted +: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.34 {interpreted +: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "+"} + } -result {can't use non-numeric string "0o8" as operand of "+"} test mathop-1.35 {interpreted +: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -189,22 +189,22 @@ namespace eval ::testmathop { test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.11 {compiled *: errors} -returnCodes error -body { * x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.12 {compiled *: errors} -returnCodes error -body { * nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.13 {compiled *: errors} -returnCodes error -body { * 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.14 {compiled *: errors} -returnCodes error -body { * 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.15 {compiled *: errors} -returnCodes error -body { * 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.16 {compiled *: errors} -returnCodes error -body { * 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.17 {compiled *: errors} -returnCodes error -body { * 0 [error expectedError] } -result expectedError @@ -227,22 +227,22 @@ namespace eval ::testmathop { test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000 test mathop-2.29 {interpreted *: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.30 {interpreted *: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.31 {interpreted *: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "*"} + } -result {can't use non-numeric string "x" as operand of "*"} test mathop-2.32 {interpreted *: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "*"} + } -result {can't use non-numeric floating-point value "nan" as operand of "*"} test mathop-2.33 {interpreted *: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.34 {interpreted *: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "*"} + } -result {can't use non-numeric string "0o8" as operand of "*"} test mathop-2.35 {interpreted *: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -261,7 +261,7 @@ namespace eval ::testmathop { test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0 test mathop-3.8 {compiled !: errors} -body { ! foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.9 {compiled !: errors} -body { ! 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -278,7 +278,7 @@ namespace eval ::testmathop { test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0 test mathop-3.18 {interpreted !: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "!"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"} test mathop-3.19 {interpreted !: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"! boolean\"" @@ -287,10 +287,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"! boolean\"" test mathop-3.21 {compiled !: error} -returnCodes error -body { ! NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-3.22 {interpreted !: error} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "!"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "!"} test mathop-4.1 {compiled ~} {~ 0} -1 test mathop-4.2 {compiled ~} {~ 1} -2 @@ -301,7 +301,7 @@ namespace eval ::testmathop { test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001 test mathop-4.8 {compiled ~: errors} -body { ~ foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.9 {compiled ~: errors} -body { ~ 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -310,10 +310,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.11 {compiled ~: errors} -returnCodes error -body { ~ 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.12 {compiled ~: errors} -returnCodes error -body { ~ NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} set op ~ test mathop-4.13 {interpreted ~} {$op 0} -1 test mathop-4.14 {interpreted ~} {$op 1} -2 @@ -324,7 +324,7 @@ namespace eval ::testmathop { test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001 test mathop-4.20 {interpreted ~: errors} -body { $op foobar - } -returnCodes error -result {can't use non-numeric string as operand of "~"} + } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"} test mathop-4.21 {interpreted ~: errors} -body { $op 0 0 } -returnCodes error -result "wrong # args: should be \"~ integer\"" @@ -333,10 +333,10 @@ namespace eval ::testmathop { } -returnCodes error -result "wrong # args: should be \"~ integer\"" test mathop-4.23 {interpreted ~: errors} -returnCodes error -body { $op 0.0 - } -result {can't use floating-point value as operand of "~"} + } -result {can't use floating-point value "0.0" as operand of "~"} test mathop-4.24 {interpreted ~: errors} -returnCodes error -body { $op NaN - } -result {can't use non-numeric floating-point value as operand of "~"} + } -result {can't use non-numeric floating-point value "NaN" as operand of "~"} test mathop-5.1 {compiled eq} {eq {} a} 0 test mathop-5.2 {compiled eq} {eq a a} 1 @@ -377,32 +377,32 @@ namespace eval ::testmathop { test mathop-6.4 {compiled &} { & 3 7 6 } 2 test mathop-6.5 {compiled &} -returnCodes error -body { & 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.6 {compiled &} -returnCodes error -body { & 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2 test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85 test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2 test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85 test mathop-6.11 {compiled &: errors} -returnCodes error -body { & x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.12 {compiled &: errors} -returnCodes error -body { & nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.13 {compiled &: errors} -returnCodes error -body { & 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.14 {compiled &: errors} -returnCodes error -body { & 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.15 {compiled &: errors} -returnCodes error -body { & 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.16 {compiled &: errors} -returnCodes error -body { & 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.17 {compiled &: errors} -returnCodes error -body { & 0 [error expectedError] } -result expectedError @@ -419,32 +419,32 @@ namespace eval ::testmathop { test mathop-6.22 {interpreted &} { $op 3 7 6 } 2 test mathop-6.23 {interpreted &} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "1.0" as operand of "&"} test mathop-6.24 {interpreted &} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "&"} + } -result {can't use floating-point value "3.0" as operand of "&"} test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2 test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85 test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2 test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85 test mathop-6.29 {interpreted &: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.30 {interpreted &: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.31 {interpreted &: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "&"} + } -result {can't use non-numeric string "x" as operand of "&"} test mathop-6.32 {interpreted &: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "&"} + } -result {can't use non-numeric floating-point value "nan" as operand of "&"} test mathop-6.33 {interpreted &: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.34 {interpreted &: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "&"} + } -result {can't use non-numeric string "0o8" as operand of "&"} test mathop-6.35 {interpreted &: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -487,32 +487,32 @@ namespace eval ::testmathop { test mathop-7.4 {compiled |} { | 3 7 6 } 7 test mathop-7.5 {compiled |} -returnCodes error -body { | 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.6 {compiled |} -returnCodes error -body { | 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110 test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503 test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110 test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.11 {compiled |: errors} -returnCodes error -body { | x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.12 {compiled |: errors} -returnCodes error -body { | nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.13 {compiled |: errors} -returnCodes error -body { | 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.14 {compiled |: errors} -returnCodes error -body { | 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.15 {compiled |: errors} -returnCodes error -body { | 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.16 {compiled |: errors} -returnCodes error -body { | 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.17 {compiled |: errors} -returnCodes error -body { | 0 [error expectedError] } -result expectedError @@ -529,32 +529,32 @@ namespace eval ::testmathop { test mathop-7.22 {interpreted |} { $op 3 7 6 } 7 test mathop-7.23 {interpreted |} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "1.0" as operand of "|"} test mathop-7.24 {interpreted |} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "|"} + } -result {can't use floating-point value "3.0" as operand of "|"} test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110 test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503 test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110 test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503 test mathop-7.29 {interpreted |: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.30 {interpreted |: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.31 {interpreted |: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "|"} + } -result {can't use non-numeric string "x" as operand of "|"} test mathop-7.32 {interpreted |: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "|"} + } -result {can't use non-numeric floating-point value "nan" as operand of "|"} test mathop-7.33 {interpreted |: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.34 {interpreted |: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "|"} + } -result {can't use non-numeric string "0o8" as operand of "|"} test mathop-7.35 {interpreted |: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -597,32 +597,32 @@ namespace eval ::testmathop { test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2 test mathop-8.5 {compiled ^} -returnCodes error -body { ^ 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.6 {compiled ^} -returnCodes error -body { ^ 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110 test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333 test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.11 {compiled ^: errors} -returnCodes error -body { ^ x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.12 {compiled ^: errors} -returnCodes error -body { ^ nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.13 {compiled ^: errors} -returnCodes error -body { ^ 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.14 {compiled ^: errors} -returnCodes error -body { ^ 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.15 {compiled ^: errors} -returnCodes error -body { ^ 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.16 {compiled ^: errors} -returnCodes error -body { ^ 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.17 {compiled ^: errors} -returnCodes error -body { ^ 0 [error expectedError] } -result expectedError @@ -639,32 +639,32 @@ namespace eval ::testmathop { test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2 test mathop-8.23 {interpreted ^} -returnCodes error -body { $op 1.0 2 3 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "1.0" as operand of "^"} test mathop-8.24 {interpreted ^} -returnCodes error -body { $op 1 2 3.0 - } -result {can't use floating-point value as operand of "^"} + } -result {can't use floating-point value "3.0" as operand of "^"} test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110 test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333 test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110 test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333 test mathop-8.29 {interpreted ^: errors} -returnCodes error -body { $op x 0 - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.30 {interpreted ^: errors} -returnCodes error -body { $op nan 0 - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.31 {interpreted ^: errors} -returnCodes error -body { $op 0 x - } -result {can't use non-numeric string as operand of "^"} + } -result {can't use non-numeric string "x" as operand of "^"} test mathop-8.32 {interpreted ^: errors} -returnCodes error -body { $op 0 nan - } -result {can't use non-numeric floating-point value as operand of "^"} + } -result {can't use non-numeric floating-point value "nan" as operand of "^"} test mathop-8.33 {interpreted ^: errors} -returnCodes error -body { $op 0o8 0 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.34 {interpreted ^: errors} -returnCodes error -body { $op 0 0o8 - } -result {can't use invalid octal number as operand of "^"} + } -result {can't use non-numeric string "0o8" as operand of "^"} test mathop-8.35 {interpreted ^: errors} -returnCodes error -body { $op 0 [error expectedError] } -result expectedError @@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } { # skipping - for now, knownbug... foreach op {+ * / & | ^ **} { lappend res [TestOp $op {*}$vals] - lappend exp "can't use non-numeric string as operand of \"$op\"\ + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric string}" } } foreach op {+ * / & | ^ **} { lappend res [TestOp $op NaN 1] - lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\ + lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\ ARITH DOMAIN {non-numeric floating-point value}" } expr {$res eq $exp ? 0 : $res} @@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } { set res {} set exp {} lappend res [TestOp / x] - lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp - x] - lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ x] - lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ! x] - lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ~ 5.0] - lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}" expr {$res eq $exp ? 0 : $res} } 0 test mathop-21.6 { unary ops, too many } { @@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } { set exp {} foreach op {& | ^} { lappend res [TestOp $op x 5] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 5 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } expr {$res eq $exp ? 0 : $res} } 0 @@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } { set exp {} foreach op {% << >>} { lappend res [TestOp $op x 1] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp $op 1 x] - lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}" } foreach op {% << >>} { lappend res [TestOp $op 5.0 1] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" lappend res [TestOp $op 1 5.0] - lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}" + lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}" } foreach op {in ni} { lappend res [TestOp $op 5 "a b \{ c"] @@ -1240,9 +1240,9 @@ test mathop-25.23 { exp operator errors } { lappend res [TestOp ** $huge 2.1] lappend exp "Inf" lappend res [TestOp ** 2 foo] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" lappend res [TestOp ** foo 2] - lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}" + lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}" expr {$res eq $exp ? 0 : $res} } 0 diff --git a/tests/msgcat.test b/tests/msgcat.test index 1522354..9fb565b 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -12,7 +12,7 @@ # Note that after running these tests, entries will be left behind in the # message catalogs for locales foo, foo_BAR, and foo_BAR_baz. -package require Tcl 8.2 +package require Tcl 8.2- if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." return diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 7910974..d667bf2 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -1045,9 +1045,8 @@ test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body { } -result {- {} 0 subexpr naner() 1 operator naner 0 {}} test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body { - catch {testexprparser 08 -1} m o - dict get $o -errorcode -} -result {TCL PARSE EXPR BADNUMBER OCTAL} + testexprparser 08 -1 +} -result {- {} 0 subexpr 08 1 text 08 0 {}} test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body { catch {testexprparser 0o8 -1} m o dict get $o -errorcode diff --git a/tests/proc.test b/tests/proc.test index e06720e..6bde259 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -362,7 +362,7 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body { namespace eval ugly {} proc ugly::foo {} { set i 0 - while { 1 } { + while { $i < 10 } { if { [incr i] > 3 } { proc continue {} {return -code break} } diff --git a/tests/safe.test b/tests/safe.test index 4a2792e..423e10e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 +package require Tcl 8.5- if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 diff --git a/tests/string.test b/tests/string.test index f558d30..e9e6e6d 100644 --- a/tests/string.test +++ b/tests/string.test @@ -280,10 +280,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} { } 0 test string-5.17 {string index, bad integer} -body { list [catch {string index "abc" 0o8} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.18 {string index, bad integer} -body { list [catch {string index "abc" end-0o0289} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test string-5.19 {string index, bytearray object out of bounds} { string index [binary format I* {0x50515253 0x52}] -1 } {} diff --git a/tests/stringComp.test b/tests/stringComp.test index 9e00ce7..210f431 100644 --- a/tests/stringComp.test +++ b/tests/stringComp.test @@ -339,11 +339,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering} test stringComp-5.17 {string index, bad integer} -body { proc foo {} {string index "abc" 0o8} list [catch {foo} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test stringComp-5.18 {string index, bad integer} -body { proc foo {} {string index "abc" end-0o0289} list [catch {foo} msg] $msg -} -match glob -result {1 {*invalid octal number*}} +} -match glob -result {1 {*}} test stringComp-5.19 {string index, bytearray object out of bounds} { proc foo {} {string index [binary format I* {0x50515253 0x52}] -1} foo diff --git a/tests/tm.test b/tests/tm.test index 149a65d..73e8261 100644 --- a/tests/tm.test +++ b/tests/tm.test @@ -6,7 +6,7 @@ # Copyright (c) 2004 by Donal K. Fellows. # All rights reserved. -package require Tcl 8.5 +package require Tcl 8.5- if {"::tcltest" ni [namespace children]} { package require tcltest 2 namespace import -force ::tcltest::* diff --git a/tests/while-old.test b/tests/while-old.test index ee17d0b..e33bd0b 100644 --- a/tests/while-old.test +++ b/tests/while-old.test @@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} { test while-old-4.4 {errors in while loops} { set err [catch {while {"a"+"b"} {error "loop aborted"}} msg] list $err $msg -} {1 {can't use non-numeric string as operand of "+"}} +} {1 {can't use non-numeric string "a" as operand of "+"}} test while-old-4.5 {errors in while loops} { catch {unset x} set x 1 diff --git a/tests/while.test b/tests/while.test index 642ec93..c25b404 100644 --- a/tests/while.test +++ b/tests/while.test @@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body { } -match glob -result {*"while {$i<} break"} test while-1.3 {TclCompileWhileCmd: error in test expression} -body { while {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-1.4 {TclCompileWhileCmd: multiline test expr} -body { set value 1 while {($tcl_platform(platform) != "foobar1") && \ @@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body { test while-4.4 {while (not compiled): error in test expression} -body { set z while $z {"a"+"b"} {error "loop aborted"} -} -returnCodes error -result {can't use non-numeric string as operand of "+"} +} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"} test while-4.5 {while (not compiled): multiline test expr} -body { set value 1 set z while diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 93e0a9a..6e49519 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.4 +package require Tcl 8.4- namespace eval genStubs { # libraryName -- @@ -1135,6 +1135,7 @@ proc genStubs::init {} { variable outDir variable interfaces +variable scspec if {[llength $argv] < 2} { puts stderr "usage: $argv0 outDir declFile ?declFile...?" exit 1 diff --git a/tools/man2html.tcl b/tools/man2html.tcl index fa57b03..124f631 100644 --- a/tools/man2html.tcl +++ b/tools/man2html.tcl @@ -2,7 +2,7 @@ # \ exec tclsh "$0" ${1+"$@"} -package require Tcl 8.4 +package require Tcl 8.4- # man2html.tcl -- # diff --git a/tools/man2html1.tcl b/tools/man2html1.tcl index f2b2e43..23a9e58 100644 --- a/tools/man2html1.tcl +++ b/tools/man2html1.tcl @@ -5,7 +5,7 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. -package require Tcl 8.4 +package require Tcl 8.4- # Global variables used by these scripts: # diff --git a/tools/man2html2.tcl b/tools/man2html2.tcl index 163196e..753fde4 100644 --- a/tools/man2html2.tcl +++ b/tools/man2html2.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1996 by Sun Microsystems, Inc. -package require Tcl 8.4 +package require Tcl 8.4- # Global variables used by these scripts: # diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 3bdccbe..4641165 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl86.cnt +CNT=tcl90.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl86.hlp +HLP=tcl90.hlp [FILES] tcl.rtf diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index 005919a..d025d72 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -30,7 +30,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. #---------------------------------------------------------------------- -package require Tcl 8.5 +package require Tcl 8.5- # Define the names of the Olson files that we need to load. # We avoid the solar time files and the leap seconds. diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index f392bce..f87f701 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,6 +1,6 @@ #!/usr/bin/env tclsh -if {[catch {package require Tcl 8.6} msg]} { +if {[catch {package require Tcl 8.6-} msg]} { puts stderr "ERROR: $msg" puts stderr "If running this script from 'make html', set the\ NATIVE_TCLSH environment\nvariable to point to an installed\ diff --git a/unix/configure b/unix/configure index f778a7b..82ca9df 100755 --- a/unix/configure +++ b/unix/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.59 for tcl 8.6. +# Generated by GNU Autoconf 2.59 for tcl 9.0. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation @@ -267,8 +267,8 @@ SHELL=${CONFIG_SHELL-/bin/sh} # Identity of this package. PACKAGE_NAME='tcl' PACKAGE_TARNAME='tcl' -PACKAGE_VERSION='8.6' -PACKAGE_STRING='tcl 8.6' +PACKAGE_VERSION='9.0' +PACKAGE_STRING='tcl 9.0' PACKAGE_BUGREPORT='' # Factoring default headers for most tests. @@ -777,7 +777,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures tcl 8.6 to adapt to many kinds of systems. +\`configure' configures tcl 9.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -834,7 +834,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of tcl 8.6:";; + short | recursive ) echo "Configuration of tcl 9.0:";; esac cat <<\_ACEOF @@ -978,7 +978,7 @@ fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF -tcl configure 8.6 +tcl configure 9.0 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. @@ -992,7 +992,7 @@ cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by tcl $as_me 8.6, which was +It was created by tcl $as_me 9.0, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ @@ -1332,10 +1332,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -19958,7 +19958,7 @@ _ASBOX } >&5 cat >&5 <<_CSEOF -This file was extended by tcl $as_me 8.6, which was +This file was extended by tcl $as_me 9.0, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -20016,7 +20016,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ -tcl config.status 8.6 +tcl config.status 9.0 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" diff --git a/unix/configure.in b/unix/configure.in index 087bb05..4ebf1af 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. -AC_INIT([tcl],[8.6]) +AC_INIT([tcl],[9.0]) AC_PREREQ(2.59) dnl This is only used when included from macosx/configure.ac @@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ #endif /* _TCLCONFIG */]) ]) -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c index c4d3f32..7e5d7d3 100644 --- a/unix/dltest/pkga.c +++ b/unix/dltest/pkga.c @@ -10,18 +10,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkga_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -124,7 +115,7 @@ Pkga_QuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkga_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index ad61d77..b32092c 100644 --- a/unix/dltest/pkgb.c +++ b/unix/dltest/pkgb.c @@ -11,7 +11,6 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 557f21b..4e3e174 100644 --- a/unix/dltest/pkgc.c +++ b/unix/dltest/pkgc.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgc_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +105,7 @@ Pkgc_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +142,7 @@ Pkgc_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 6e114e9..4a1defa 100644 --- a/unix/dltest/pkgd.c +++ b/unix/dltest/pkgd.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgd_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -114,7 +105,7 @@ Pkgd_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -151,7 +142,7 @@ Pkgd_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index d616352..36c8c1a 100644 --- a/unix/dltest/pkge.c +++ b/unix/dltest/pkge.c @@ -11,17 +11,8 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" -/* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkge_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - /* *---------------------------------------------------------------------- @@ -40,7 +31,7 @@ *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkge_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 417bedb..2a38525 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -11,18 +11,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#undef STATIC_BUILD #include "tcl.h" /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Pkgua_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * Prototypes for procedures defined later in this file: */ @@ -200,7 +191,7 @@ PkguaQuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -253,7 +244,7 @@ Pkgua_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -278,7 +269,7 @@ Pkgua_SafeInit( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Unload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ @@ -331,7 +322,7 @@ Pkgua_Unload( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_SafeUnload( Tcl_Interp *interp, /* Interpreter from which the package is to be * unloaded. */ diff --git a/unix/tcl.spec b/unix/tcl.spec index 27f7189..f4839ce 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 8.6.0 +Version: 9.0a0 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c index 159bbd8..21dce71 100644 --- a/unix/tclAppInit.c +++ b/unix/tclAppInit.c @@ -150,9 +150,9 @@ Tcl_AppInit( */ #ifdef DJGPP - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY); + (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclsh.rc", TCL_GLOBAL_ONLY); #else - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); + (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/.tclshrc", TCL_GLOBAL_ONLY); #endif return TCL_OK; diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index c10225d..3bed9b2 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -67,10 +67,10 @@ static Tcl_CmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_CmdProc TestgetdefencdirCmd; +static Tcl_ObjCmdProc TestgetdefencdirCmd; static Tcl_CmdProc TestgetopenfileCmd; static Tcl_CmdProc TestgotsigCmd; -static Tcl_CmdProc TestsetdefencdirCmd; +static Tcl_ObjCmdProc TestsetdefencdirCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); @@ -105,9 +105,9 @@ TclplatformtestInit( NULL, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, + Tcl_CreateObjCommand(interp, "testgetdefenc", TestgetdefencdirCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, + Tcl_CreateObjCommand(interp, "testsetdefenc", TestsetdefencdirCmd, NULL, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); @@ -514,16 +514,22 @@ static int TestsetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " defaultDir\"", NULL); + Tcl_Obj *searchPath; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "defaultDir"); return TCL_ERROR; } - Tcl_SetDefaultEncodingDir(argv[1]); + searchPath = Tcl_GetEncodingSearchPath(); + + searchPath = Tcl_DuplicateObj(searchPath); + Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &objv[1]); + Tcl_SetEncodingSearchPath(searchPath); + return TCL_OK; } @@ -548,15 +554,25 @@ static int TestgetdefencdirCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const *objv) /* Argument strings. */ { - if (argc != 1) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); - return TCL_ERROR; + int numDirs; + Tcl_Obj *first, *searchPath; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, NULL); + return TCL_ERROR; + } + + searchPath = Tcl_GetEncodingSearchPath(); + Tcl_ListObjLength(interp, searchPath, &numDirs); + if (numDirs == 0) { + return TCL_ERROR; } + Tcl_ListObjIndex(NULL, searchPath, 0, &first); - Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL); + Tcl_SetObjResult(interp, first); return TCL_OK; } diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 926e8f4..5fbbe54 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -20,18 +20,6 @@ #define IsLeapYear(x) (((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0)) /* - * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread - * safety, this structure must be in thread-specific data. The 'tmKey' - * variable is the key to this buffer. - */ - -static Tcl_ThreadDataKey tmKey; -typedef struct ThreadSpecificData { - struct tm gmtime_buf; - struct tm localtime_buf; -} ThreadSpecificData; - -/* * If we fall back on the thread-unsafe versions of gmtime and localtime, use * this mutex to try to protect them. */ @@ -251,114 +239,6 @@ Tcl_GetTime( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGetDate( - const time_t *time, - int useGMT) -{ - if (useGMT) { - return TclpGmtime(time); - } else { - return TclpLocaltime(time); - } -} - -/* - *---------------------------------------------------------------------- - * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - -#ifdef HAVE_GMTIME_R - gmtime_r(timePtr, &tsdPtr->gmtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->gmtime_buf, gmtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->gmtime_buf; -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * Get a thread-local buffer to hold the returned time. - */ - - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey); - - SetTZIfNecessary(); -#ifdef HAVE_LOCALTIME_R - localtime_r(timePtr, &tsdPtr->localtime_buf); -#else - Tcl_MutexLock(&tmMutex); - memcpy(&tsdPtr->localtime_buf, localtime(timePtr), sizeof(struct tm)); - Tcl_MutexUnlock(&tmMutex); -#endif - - return &tsdPtr->localtime_buf; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the @@ -1,4 +1,4 @@ -Tcl 8.6 for Windows +Tcl 9.0 for Windows 1. Introduction --------------- @@ -16,7 +16,7 @@ The information in this file is maintained on the web at: In order to compile Tcl for Windows, you need the following: - Tcl 8.6 Source Distribution (plus any patches) + Tcl 9.0 Source Distribution (plus any patches) and diff --git a/win/configure b/win/configure index 03a20b4..ba10113 100755 --- a/win/configure +++ b/win/configure @@ -1308,10 +1308,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/configure.in b/win/configure.in index b0c007a..e74a745 100644 --- a/win/configure.in +++ b/win/configure.in @@ -11,10 +11,10 @@ AC_PREREQ(2.59) # /bin/sh. The bash shell seems to suffer from some strange failures. SHELL=/bin/sh -TCL_VERSION=8.6 -TCL_MAJOR_VERSION=8 -TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".0" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 diff --git a/win/makefile.bc b/win/makefile.bc index 18bfa28..bd71169 100644 --- a/win/makefile.bc +++ b/win/makefile.bc @@ -123,8 +123,8 @@ CFG_ENCODING = \"cp1252\" NAMEPREFIX = tcl STUBPREFIX = $(NAMEPREFIX)stub -DOTVERSION = 8.6 -VERSION = 86 +DOTVERSION = 9.0 +VERSION = 90 DDEVERSION = 14 DDEDOTVERSION = 1.4 @@ -2,7 +2,7 @@ // #include <winver.h> -#include <tcl.h> +#include "tclWinInt.h" // // build-up the name suffix that defines the type of build this is. diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 56f45a0..5ecebea 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -193,7 +193,7 @@ Tcl_AppInit( * specific startup file will be run under any conditions. */ - (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY); + (Tcl_SetVar2)(interp, "tcl_rcFileName", NULL, "~/tclshrc.tcl", TCL_GLOBAL_ONLY); return TCL_OK; } diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d0600e6..9b3872e 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -33,16 +33,6 @@ #endif /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init - * declaration is in the source file itself, which is only accessed when we - * are building a library. DO NOT MOVE BEFORE ANY #include LINES. ONLY USE - * EXTERN TO INDICATE EXPORTED FUNCTIONS FROM NOW ON. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -134,8 +124,8 @@ static int DdeObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int Dde_Init(Tcl_Interp *interp); -EXTERN int Dde_SafeInit(Tcl_Interp *interp); +DLLEXPORT int Dde_Init(Tcl_Interp *interp); +DLLEXPORT int Dde_SafeInit(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -157,7 +147,7 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.1", 0)) { + if (!Tcl_InitStubs(interp, TCL_VERSION, 0)) { return TCL_ERROR; } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 22ad8e9..b3753f4 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -15,6 +15,20 @@ #include "tclInt.h" /* + * Utility macros: STRINGIFY takes an argument and wraps it in "" (double + * quotation marks), JOIN joins two arguments. + */ + +#ifndef STRINGIFY +# define STRINGIFY(x) STRINGIFY1(x) +# define STRINGIFY1(x) #x +#endif +#ifndef JOIN +# define JOIN(a,b) JOIN1(a,b) +# define JOIN1(a,b) a##b +#endif + +/* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. * Define VER_PLATFORM_WIN32_CE for those without newer headers. diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 6ac5caf..619d9df 100644 --- a/win/tclWinReg.c +++ b/win/tclWinReg.c @@ -49,15 +49,6 @@ #endif /* - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the - * Registry_Init declaration is in the source file itself, which is only - * accessed when we are building a library. - */ - -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -/* * The following macros convert between different endian ints. */ @@ -140,8 +131,8 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, Tcl_Obj *typeObj, REGSAM mode); -EXTERN int Registry_Init(Tcl_Interp *interp); -EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); +DLLEXPORT int Registry_Init(Tcl_Interp *interp); +DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); /* *---------------------------------------------------------------------- @@ -165,7 +156,7 @@ Registry_Init( { Tcl_Command cmd; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { return TCL_ERROR; } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index daa229d..9cfbac0 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -12,10 +12,6 @@ #include "tclInt.h" -#define SECSPERDAY (60L * 60L * 24L) -#define SECSPERYEAR (SECSPERDAY * 365L) -#define SECSPER4YEAR (SECSPERYEAR * 4L + SECSPERDAY) - /* * Number of samples over which to estimate the performance counter. */ @@ -23,25 +19,6 @@ #define SAMPLES 64 /* - * The following arrays contain the day of year for the last day of each - * month, where index 1 is January. - */ - -static const int normalDays[] = { - -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364 -}; - -static const int leapDays[] = { - -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 -}; - -typedef struct ThreadSpecificData { - char tzName[64]; /* Time zone name */ - struct tm tm; /* time information */ -} ThreadSpecificData; -static Tcl_ThreadDataKey dataKey; - -/* * Data for managing high-resolution timers. */ @@ -113,7 +90,6 @@ static TimeInfo timeInfo = { * Declarations for functions defined later in this file. */ -static struct tm * ComputeGMT(const time_t *tp); static void StopCalibration(ClientData clientData); static DWORD WINAPI CalibrationThread(LPVOID arg); static void UpdateTimeEachSecond(void); @@ -489,227 +465,6 @@ StopCalibration( /* *---------------------------------------------------------------------- * - * TclpGetDate -- - * - * This function converts between seconds and struct tm. If useGMT is - * true, then the returned date will be in Greenwich Mean Time (GMT). - * Otherwise, it will be in the local time zone. - * - * Results: - * Returns a static tm structure. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGetDate( - const time_t *t, - int useGMT) -{ - struct tm *tmPtr; - time_t time; - - if (!useGMT) { - tzset(); - - /* - * If we are in the valid range, let the C run-time library handle it. - * Otherwise we need to fake it. Note that this algorithm ignores - * daylight savings time before the epoch. - */ - - /* - * Hm, Borland's localtime manages to return NULL under certain - * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this, - * since 'localtime' isn't supposed to do this, possibly leading to - * crashes. - * - * Patch: We only call this function if we are at least one day into - * the epoch, else we handle it ourselves (like we do for times < 0). - * H. Giese, June 2003 - */ - -#ifdef __BORLANDC__ -#define LOCALTIME_VALIDITY_BOUNDARY SECSPERDAY -#else -#define LOCALTIME_VALIDITY_BOUNDARY 0 -#endif - - if (*t >= LOCALTIME_VALIDITY_BOUNDARY) { - return TclpLocaltime(t); - } - - time = *t - timezone; - - /* - * If we aren't near to overflowing the long, just add the bias and - * use the normal calculation. Otherwise we will need to adjust the - * result at the end. - */ - - if (*t < (LONG_MAX - 2*SECSPERDAY) && *t > (LONG_MIN + 2*SECSPERDAY)) { - tmPtr = ComputeGMT(&time); - } else { - tmPtr = ComputeGMT(t); - - tzset(); - - /* - * Add the bias directly to the tm structure to avoid overflow. - * Propagate seconds overflow into minutes, hours and days. - */ - - time = tmPtr->tm_sec - timezone; - tmPtr->tm_sec = (int)(time % 60); - if (tmPtr->tm_sec < 0) { - tmPtr->tm_sec += 60; - time -= 60; - } - - time = tmPtr->tm_min + time/60; - tmPtr->tm_min = (int)(time % 60); - if (tmPtr->tm_min < 0) { - tmPtr->tm_min += 60; - time -= 60; - } - - time = tmPtr->tm_hour + time/60; - tmPtr->tm_hour = (int)(time % 24); - if (tmPtr->tm_hour < 0) { - tmPtr->tm_hour += 24; - time -= 24; - } - - time /= 24; - tmPtr->tm_mday += (int)time; - tmPtr->tm_yday += (int)time; - tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7; - } - } else { - tmPtr = ComputeGMT(t); - } - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * - * ComputeGMT -- - * - * This function computes GMT given the number of seconds since the epoch - * (midnight Jan 1 1970). - * - * Results: - * Returns a (per thread) statically allocated struct tm. - * - * Side effects: - * Updates the values of the static struct tm. - * - *---------------------------------------------------------------------- - */ - -static struct tm * -ComputeGMT( - const time_t *tp) -{ - struct tm *tmPtr; - long tmp, rem; - int isLeap; - const int *days; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - - tmPtr = &tsdPtr->tm; - - /* - * Compute the 4 year span containing the specified time. - */ - - tmp = (long)(*tp / SECSPER4YEAR); - rem = (long)(*tp % SECSPER4YEAR); - - /* - * Correct for weird mod semantics so the remainder is always positive. - */ - - if (rem < 0) { - tmp--; - rem += SECSPER4YEAR; - } - - /* - * Compute the year after 1900 by taking the 4 year span and adjusting for - * the remainder. This works because 2000 is a leap year, and 1900/2100 - * are out of the range. - */ - - tmp = (tmp * 4) + 70; - isLeap = 0; - if (rem >= SECSPERYEAR) { /* 1971, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR) { /* 1972, etc. */ - tmp++; - rem -= SECSPERYEAR; - if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */ - tmp++; - rem -= SECSPERYEAR + SECSPERDAY; - } else { - isLeap = 1; - } - } - } - tmPtr->tm_year = tmp; - - /* - * Compute the day of year and leave the seconds in the current day in the - * remainder. - */ - - tmPtr->tm_yday = rem / SECSPERDAY; - rem %= SECSPERDAY; - - /* - * Compute the time of day. - */ - - tmPtr->tm_hour = rem / 3600; - rem %= 3600; - tmPtr->tm_min = rem / 60; - tmPtr->tm_sec = rem % 60; - - /* - * Compute the month and day of month. - */ - - days = (isLeap) ? leapDays : normalDays; - for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) { - /* empty body */ - } - tmPtr->tm_mon = --tmp; - tmPtr->tm_mday = tmPtr->tm_yday - days[tmp]; - - /* - * Compute day of week. Epoch started on a Thursday. - */ - - tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4; - if ((*tp % SECSPERDAY) < 0) { - tmPtr->tm_wday--; - } - tmPtr->tm_wday %= 7; - if (tmPtr->tm_wday < 0) { - tmPtr->tm_wday += 7; - } - - return tmPtr; -} - -/* - *---------------------------------------------------------------------- - * * CalibrationThread -- * * Thread that manages calibration of the hi-resolution time derived from @@ -1037,67 +792,6 @@ AccumulateSample( /* *---------------------------------------------------------------------- * - * TclpGmtime -- - * - * Wrapper around the 'gmtime' library function to make it thread safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes gmtime or gmtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpGmtime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of gmtime is thread safe because it returns the - * time in a block of thread-local storage, and Windows does not provide a - * Posix gmtime_r function. - */ - - return gmtime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * - * TclpLocaltime -- - * - * Wrapper around the 'localtime' library function to make it thread - * safe. - * - * Results: - * Returns a pointer to a 'struct tm' in thread-specific data. - * - * Side effects: - * Invokes localtime or localtime_r as appropriate. - * - *---------------------------------------------------------------------- - */ - -struct tm * -TclpLocaltime( - const time_t *timePtr) /* Pointer to the number of seconds since the - * local system's epoch */ -{ - /* - * The MS implementation of localtime is thread safe because it returns - * the time in a block of thread-local storage, and Windows does not - * provide a Posix localtime_r function. - */ - - return localtime(timePtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetTimeProc -- * * TIP #233 (Virtualized Time): Registers two handlers for the diff --git a/win/tclsh.rc b/win/tclsh.rc index 16eaf83..6e1114d 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -2,7 +2,7 @@ // #include <winver.h> -#include <tcl.h> +#include "tclWinInt.h" // // build-up the name suffix that defines the type of build this is. |