diff options
204 files changed, 2964 insertions, 7577 deletions
@@ -1,6 +1,6 @@ <?xml version="1.0" encoding="UTF-8"?> <projectDescription> - <name>tcl8.6</name> + <name>tcl9.0</name> <comment></comment> <projects> </projects> @@ -476,13 +476,6 @@ a better first place to look now. created by the http package will always be operated in asynchronous mode. -2013-01-21 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName) - in private stub table, so extensions using this (like Tk 8.4) will - continue to work in all Tcl 8.x versions. Extensions using this - still cannot be compiled against Tcl 8.6 headers. - 2013-01-18 Jan Nijtmans <nijtmans@users.sf.net> * generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include @@ -525,18 +518,6 @@ a better first place to look now. * doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false positives" in the case of multibyte encodings/transforms. -2013-01-13 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure - that TIP #139 functions all are taken from the public stub table, even - if the inclusion is through tclInt.h. - -2013-01-12 Jan Nijtmans <nijtmans@users.sf.net> - - * generic/tclInt.decls: Put back TclBackgroundException in internal - stub table, so extensions using this, compiled against 8.5 headers - still run in Tcl 8.6. - 2013-01-09 Jan Nijtmans <nijtmans@users.sf.net> * library/http/http.tcl: [Bug 3599395]: http assumes status line is a @@ -559,8 +540,9 @@ a better first place to look now. 2013-01-06 Jan Nijtmans <nijtmans@users.sf.net> * library/http/http.tcl: Don't depend on Spencer-specific regexp - * tests/env.test: syntax (/u and /U) any more in unrelated places. + * tests/env.test: syntax (/u and /U) any more. * tests/exec.test: + * tests/reg.test: Bump http package to 2.8.6. 2013-01-04 Donal K. Fellows <dkf@users.sf.net> @@ -685,8 +667,8 @@ a better first place to look now. 2012-12-07 Jan Nijtmans <nijtmans@users.sf.net> - * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl9 interoperability test - library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should + * unix/dltest/pkgb.c: Turn pkgb.so into a Tcl8 interoperability test + library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 8 should either result in an error-message, either succeed, but never crash. 2012-11-28 Donal K. Fellows <dkf@users.sf.net> @@ -8835,14 +8817,15 @@ a better first place to look now. implementation of the mkstemp() function, which is apparently needed on some platforms. - ****************************************************************** - *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" *** - *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" *** - *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** - *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** - *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** - *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** - *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** - *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** - *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** - ****************************************************************** + ****************************************************************** + *** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008" *** + *** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007" *** + *** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005" *** + *** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004" *** + *** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003" *** + *** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002" *** + *** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001" *** + *** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000" *** + *** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" *** + ****************************************************************** + @@ -1,5 +1,5 @@ README: Tcl - This is the Tcl 8.6.1 source distribution. + This is the Tcl 9.0a0 source distribution. http://sourceforge.net/projects/tcl/files/Tcl/ You can get any source release of Tcl from the URL above. @@ -8164,143 +8164,6 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows) --- Released 8.6.0, December 20, 2012 --- See ChangeLog for details --- -2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd) - -2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans) - -2013-01-04 (bug fix) memleak in [format] compiler (fellows) - -2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points - -2013-01-09 (bug fix)[3599395] status line processing (nijtmans) -2013-01-23 (bug fix)[2911139] repair async connection management (fellows) -=> http 2.8.6 - -2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans) - -2013-01-28 (enhancement) improve ensemble bytecode (fellows) - -2013-01-30 (enhancement) selected script code improvements (fradin) -=> tcltest 2.3.6 - -2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries) -=> platform 1.0.11 - -2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff) - -2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin) - -2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows) - -2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows) - -2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans) -=> msgcat 1.5.1 - -2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick) - -2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter) - -2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max) - -2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane) - -2013-03-03 (bug fix)[3606258] major serial port update (english) - -2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs -(grathwohl,lane,porter) - -2013-03-12 (enhancement) better build support for Debian arch (shadura) - -2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans) - -2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin) - -2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter - -2013-04-04 (bug fix) Support URLs with query but no path (max) -=> http 2.8.7 - -2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas) - -2013-04-29 (enhancement) [array set] compile improvement (fellows) - -2013-04-30 (enhancement) broaden glibc version detection (kupries) -=> platform 1.0.12 - -2013-05-06 (platform support) Cygwin64 (nijtmans) - -2013-05-15 (enhancement) Improved [list {*}...] compile (fellows) - -2013-05-16 (platform support) mingw-4.0 (nijtmans) - -2013-05-19 (platform support) FreeBSD updates (cerutti) - -2013-05-20 (bug fix)[3613567] access error temp file creation (keene) - -2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene) - -2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows) - -2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann) +2013-05-08 (bug fix)[3036566] Honor language packs on Vista+ to get initial locale (oehlmann) => msgcat 1.5.2 -2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter) - -2013-06-03 Restored lost performance appending to long strings (elby,porter) - -2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows) - -2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans) - -2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans) - -2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang) - -2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin) - -2013-07-06 tzdata updated to Olson's tzdata2013d (kenny) - -2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter) - -2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter) - -2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane) - -2013-07-29 [string is space \u202f] => 1 (nijtmans) - -2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans) - -2013-08-01 (bug fix)[1905562] RE recursion limit increased to support -reported usage of large expressions (porter) - -2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows) - -2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows) - -2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter) - -2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter) - -2013-08-15 Errors from execution traces become errors of the command (porter) - -2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter) - -2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter) - -2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows) - -2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter) - -2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows) -=> TclOO 1.0.1 - -2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows) - -2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter) - -2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter) - -Many optmizations, improvements, and tightened stack management in bytecode. - ---- Released 8.6.1, Septemer 20, 2013 --- http://core.tcl.tk/tcl/ for details diff --git a/compat/float.h b/compat/float.h deleted file mode 100644 index 411edbf..0000000 --- a/compat/float.h +++ /dev/null @@ -1,14 +0,0 @@ -/* - * float.h -- - * - * This is a dummy header file to #include in Tcl when there - * is no float.h in /usr/include. Right now this file is empty: - * Tcl contains #ifdefs to deal with the lack of definitions; - * all it needs is for the #include statement to work. - * - * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index 2343e66..c556199 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -29,9 +29,7 @@ terminates with a completion code other than \fBTCL_OK\fR, \fBTCL_ERROR\fR 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_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\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 f121c7c..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. -'\" -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_Backslash \- parse a backslash sequence -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -char -\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) -.SH ARGUMENTS -.AS char *countPtr out -.AP char *src in -Pointer to a string starting with a backslash. -.AP int *countPtr out -If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled -in with number of characters in the backslash sequence, including -the backslash character. -.BE - -.SH DESCRIPTION -.PP -The use of \fBTcl_Backslash\fR is deprecated in favor of -\fBTcl_UtfBackslash\fR. -.PP -This is a utility procedure provided for backwards compatibility with -non-internationalized Tcl extensions. It parses a backslash sequence and -returns the low byte of the Unicode character corresponding to the sequence. -\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of -characters in the backslash sequence. -.PP -See the Tcl manual entry for information on the valid backslash sequences. -All of the sequences described in the Tcl manual entry are supported by -\fBTcl_Backslash\fR. -.SH "SEE ALSO" -Tcl(n), Tcl_UtfBackslash(3) - -.SH KEYWORDS -backslash, parse diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index 679795e..e58188b 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -108,31 +108,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_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_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 84cde65..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. -'\" -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions -.SH "NOTICE OF EVENTUAL DEPRECATION" -.PP -The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions -are rendered somewhat obsolete by the ability to create functions for -expressions by placing commands in the \fBtcl::mathfunc\fR namespace, -as described in the \fBmathfunc\fR manual page; the API described on -this page is not expected to be maintained indefinitely. -.SH SYNOPSIS -.nf -\fB#include <tcl.h>\fR -.sp -void -\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) -.sp -int -\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, - clientDataPtr\fR) -.sp -Tcl_Obj * -\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) -.SH ARGUMENTS -.AS Tcl_ValueType *clientDataPtr out -.AP Tcl_Interp *interp in -Interpreter in which new function will be defined. -.AP "const char" *name in -Name for new function. -.AP int numArgs in -Number of arguments to new function; also gives size of \fIargTypes\fR array. -.AP Tcl_ValueType *argTypes in -Points to an array giving the permissible types for each argument to -function. -.AP Tcl_MathProc *proc in -Procedure that implements the function. -.AP ClientData clientData in -Arbitrary one-word value to pass to \fIproc\fR when it is invoked. -.AP int *numArgsPtr out -Points to a variable that will be set to contain the number of -arguments to the function. -.AP Tcl_ValueType **argTypesPtr out -Points to a variable that will be set to contain a pointer to an array -giving the permissible types for each argument to the function which -will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc **procPtr out -Points to a variable that will be set to contain a pointer to the -implementation code for the function (or NULL if the function is -implemented directly in bytecode). -.AP ClientData *clientDataPtr out -Points to a variable that will be set to contain the clientData -argument passed to \fITcl_CreateMathFunc\fR when the function was -created if the function is not implemented directly in bytecode. -.AP "const char" *pattern in -Pattern to match against function names so as to filter them (by -passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. -.BE -.SH DESCRIPTION -.PP -Tcl allows a number of mathematical functions to be used in -expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. -These functions are represented by commands in the namespace, -\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is -an obsolete way for applications to add additional functions -to those already provided by Tcl or to replace existing functions. -It should not be used by new applications, which should create -math functions using \fBTcl_CreateObjCommand\fR to create a command -in the \fBtcl::mathfunc\fR namespace. -.PP -In the \fBTcl_CreateMathFunc\fR interface, -\fIName\fR is the name of the function as it will appear in expressions. -If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR -namespace, then a new command is created in that namespace. -If \fIname\fR does exist, then the existing function is replaced. -\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. -Each entry in the \fIargTypes\fR array must be -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, -or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an -integer, a double-precision floating value, a wide (64-bit) integer, -or any, respectively. -.PP -Whenever the function is invoked in an expression Tcl will invoke -\fIproc\fR. \fIProc\fR should have arguments and result that match -the type \fBTcl_MathProc\fR: -.PP -.CS -typedef int \fBTcl_MathProc\fR( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tcl_Value *\fIargs\fR, - Tcl_Value *\fIresultPtr\fR); -.CE -.PP -When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR -arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. -\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, -which describe the actual arguments to the function: -.PP -.CS -typedef struct Tcl_Value { - Tcl_ValueType \fItype\fR; - long \fIintValue\fR; - double \fIdoubleValue\fR; - Tcl_WideInt \fIwideValue\fR; -} \fBTcl_Value\fR; -.CE -.PP -The \fItype\fR field indicates the type of the argument and is -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. -It will match the \fIargTypes\fR value specified for the function unless -the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts -the argument supplied in the expression to the type requested in -\fIargTypes\fR, if that is necessary. -Depending on the value of the \fItype\fR field, the \fIintValue\fR, -\fIdoubleValue\fR or \fIwideValue\fR -field will contain the actual value of the argument. -.PP -\fIProc\fR should compute its result and store it either as an integer -in \fIresultPtr->intValue\fR or as a floating value in -\fIresultPtr->doubleValue\fR. -It should set also \fIresultPtr->type\fR to one of -\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR -to indicate which value was set. -Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. -If an error occurs while executing the function, \fIproc\fR should -return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. -.PP -\fBTcl_GetMathFuncInfo\fR retrieves the values associated with -function \fIname\fR that were passed to a preceding -\fBTcl_CreateMathFunc\fR call. Normally, the return code is -\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR -is returned and an error message is placed in the interpreter's -result. -.PP -If an error did not occur, the array reference placed in the variable -pointed to by \fIargTypesPtr\fR is newly allocated, and should be -released by passing it to \fBTcl_Free\fR. Some functions (the -standard set implemented in the core, and those defined by placing -commands in the \fBtcl::mathfunc\fR namespace) do not have -argument type information; attempting to retrieve values for -them causes a NULL to be stored in the variable pointed to by -\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR -will not be modified. The variable pointed to by \fInumArgsPointer\fR -will contain -1, and no argument types will be stored in the variable -pointed to by \fIargTypesPointer\fR. -.PP -\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all -the math functions defined in the interpreter whose name matches -\fIpattern\fR. The returned value has a reference count of zero. -.SH "SEE ALSO" -expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) -.SH KEYWORDS -expression, mathematical function diff --git a/doc/DString.3 b/doc/DString.3 index 0e571d2..f7567dc 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -9,7 +9,7 @@ .so man.macros .BS .SH NAME -Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_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 1478c35..ddddab6 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, 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 @@ .so man.macros .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 \- 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 @@ -29,18 +26,6 @@ int .sp 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 -\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR) .SH ARGUMENTS .AS Tcl_Interp **termPtr .AP Tcl_Interp *interp in @@ -93,22 +78,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,35 +97,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). -.PP -\fBTcl_VarEval\fR takes any number of string arguments -of any length, concatenates them into a single string, -then calls \fBTcl_Eval\fR to execute that string as a Tcl command. -It returns the result of the command and also modifies -\fIinterp->result\fR in the same way as \fBTcl_Eval\fR. -The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end -of arguments. \fBTcl_VarEval\fR is now deprecated. -.PP -\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that -instead of taking a variable number of arguments it takes an argument -list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated. +additional arguments \fInumBytes\fR and \fIflags\fR. \fBTcl_EvalEx\fR +is generally preferred over \fBTcl_Eval\fR. .SH "FLAG BITS" .PP diff --git a/doc/GetInt.3 b/doc/GetInt.3 index 4e9d636..38a75ae 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/InitStubs.3 b/doc/InitStubs.3 index 73c3437..a94b697 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -63,9 +63,9 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the \fB\-DUSE_TCL_STUBS\fR flag when compiling the extension. .IP 3) 5 Link the extension with the Tcl stubs library instead of the standard -Tcl library. For example, to use the Tcl 8.6 ABI on Unix platforms, -the library name is \fIlibtclstub8.6.a\fR; on Windows platforms, the -library name is \fItclstub86.lib\fR. +Tcl library. For example, to use the Tcl 9.0 ABI on Unix platforms, +the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the +library name is \fItclstub90.lib\fR. .PP If the extension also requires the Tk API, it must also call \fBTk_InitStubs\fR to initialize the Tk stubs interface and link diff --git a/doc/Interp.3 b/doc/Interp.3 index b639add..55730d9 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 7090dd3..d34e52f 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_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 387cc44..7035ce4 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 e1625ff..ece2f62 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 904d4ab..c4eb4b9 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 1f86340..c862481 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 @@ -102,7 +102,7 @@ The length of the Unicode string in characters. Must be greater than or equal to 0. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. -.AP "unsigned long" numChars in +.AP "size_t" numChars in The number of characters to compare. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index 54d5bf4..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. -'\" -.TH case n 7.0 Tcl "Tcl Built-In Commands" -.so man.macros -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -case \- Evaluate one of several scripts, depending on a given value -.SH SYNOPSIS -\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...? -.sp -\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?} -.BE - -.SH DESCRIPTION -.PP -\fINote: the \fBcase\fI command is obsolete and is supported only -for backward compatibility. At some point in the future it may be -removed entirely. You should use the \fBswitch\fI command instead.\fR -.PP -The \fBcase\fR command matches \fIstring\fR against each of -the \fIpatList\fR arguments in order. -Each \fIpatList\fR argument is a list of one or -more patterns. If any of these patterns matches \fIstring\fR then -\fBcase\fR evaluates the following \fIbody\fR argument -by passing it recursively to the Tcl interpreter and returns the result -of that evaluation. -Each \fIpatList\fR argument consists of a single -pattern or list of patterns. Each pattern may contain any of the wild-cards -described under \fBstring match\fR. If a \fIpatList\fR -argument is \fBdefault\fR, the corresponding body will be evaluated -if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument -matches \fIstring\fR and no default is given, then the \fBcase\fR -command returns an empty string. -.PP -Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments. -The first uses a separate argument for each of the patterns and commands; -this form is convenient if substitutions are desired on some of the -patterns or commands. -The second form places all of the patterns and commands together into -a single argument; the argument must have proper list structure, with -the elements of the list being the patterns and commands. -The second form makes it easy to construct multi-line case commands, -since the braces around the whole list make it unnecessary to include a -backslash at the end of each line. -Since the \fIpatList\fR arguments are in braces in the second form, -no command or variable substitutions are performed on them; this makes -the behavior of the second form different than the first form in some -cases. - -.SH "SEE ALSO" -switch(n) - -.SH KEYWORDS -case, match, regular expression @@ -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 @@ -484,7 +484,7 @@ not the effective ones. .TP \fBWindows\fR\0\0\0\0 . -The \fBfile owned\fR subcommand currently always reports that the current user +The \fbfile owned\fR subcommand currently always reports that the current user is the owner of the file, without regard for what the operating system believes to be true, making an ownership test useless. This issue (#3613671) may be fixed in a future release of Tcl. @@ -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 @@ -356,7 +356,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 84853d8..382ff82 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/regc_lex.c b/generic/regc_lex.c index 132e757..70a0246 100644 --- a/generic/regc_lex.c +++ b/generic/regc_lex.c @@ -444,7 +444,7 @@ next( if (ATEOS()) { FAILW(REG_EESCAPE); } - (DISCARD)lexescape(v); + (void)lexescape(v); switch (v->nexttype) { /* not all escapes okay here */ case PLAIN: return 1; @@ -703,7 +703,7 @@ next( } RETV(PLAIN, *v->now++); } - (DISCARD)lexescape(v); + (void)lexescape(v); if (ISERR()) { FAILW(REG_EESCAPE); } @@ -1130,7 +1130,7 @@ skip( /* - newline - return the chr for a newline * This helps confine use of CHR to this source file. - ^ static chr newline(NOPARMS); + ^ static chr newline(void); */ static chr newline(void) @@ -1143,7 +1143,7 @@ newline(void) * This helps confine use of CHR to this source file. Beware that the caller * knows how long the sequence is. ^ #ifdef REG_DEBUG - ^ static const chr *ch(NOPARMS); + ^ static const chr *ch(void); ^ #endif */ #ifdef REG_DEBUG diff --git a/generic/regc_locale.c b/generic/regc_locale.c index 0f8d1b2..0006635 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -1160,7 +1160,7 @@ cmp( const chr *x, const chr *y, /* strings to compare */ size_t len) /* exact length of comparison */ { - return memcmp(VS(x), VS(y), len*sizeof(chr)); + return memcmp((void*)(x), (void*)(y), len*sizeof(chr)); } /* diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 42489dd..4f62280 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -617,7 +617,7 @@ moveins( /* - copyins - copy in arcs of a state to another state * Either all arcs, or only non-empty ones as determined by all value. - ^ static VOID copyins(struct nfa *, struct state *, struct state *, int); + ^ static void copyins(struct nfa *, struct state *, struct state *, int); */ static void copyins( @@ -660,7 +660,7 @@ moveouts( /* - copyouts - copy out arcs of a state to another state * Either all arcs, or only non-empty ones as determined by all value. - ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int); + ^ static void copyouts(struct nfa *, struct state *, struct state *, int); */ static void copyouts( diff --git a/generic/regcomp.c b/generic/regcomp.c index c93eb24..9d115f9 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -82,9 +82,9 @@ static int lexescape(struct vars *); static int lexdigits(struct vars *, int, int, int); static int brenext(struct vars *, pchr); static void skip(struct vars *); -static chr newline(NOPARMS); +static chr newline(void); #ifdef REG_DEBUG -static const chr *ch(NOPARMS); +static const chr *ch(void); #endif static chr chrnamed(struct vars *, const chr *, const chr *, pchr); /* === regc_color.c === */ @@ -328,13 +328,13 @@ compile( re->re_info = 0; /* bits get set during parse */ re->re_csize = sizeof(chr); re->re_guts = NULL; - re->re_fns = VS(&functions); + re->re_fns = (void*)(&functions); /* * More complex setup, malloced things. */ - re->re_guts = VS(MALLOC(sizeof(struct guts))); + re->re_guts = (void*)(MALLOC(sizeof(struct guts))); if (re->re_guts == NULL) { return freev(v, REG_ESPACE); } @@ -421,7 +421,7 @@ compile( * Can sacrifice main NFA now, so use it as work area. */ - (DISCARD) optimize(v->nfa, debug); + (void) optimize(v->nfa, debug); CNOERR(); makesearch(v, v->nfa); CNOERR(); @@ -1874,10 +1874,10 @@ nfatree( assert(t != NULL && t->begin != NULL); if (t->left != NULL) { - (DISCARD) nfatree(v, t->left, f); + (void) nfatree(v, t->left, f); } if (t->right != NULL) { - (DISCARD) nfatree(v, t->right, f); + (void) nfatree(v, t->right, f); } return nfanode(v, t, f); diff --git a/generic/regcustom.h b/generic/regcustom.h index 1c970ea..647b423 100644 --- a/generic/regcustom.h +++ b/generic/regcustom.h @@ -36,10 +36,9 @@ * Overrides for regguts.h definitions, if any. */ -#define FUNCPTR(name, args) (*name)args -#define MALLOC(n) VS(attemptckalloc(n)) -#define FREE(p) ckfree(VS(p)) -#define REALLOC(p,n) VS(attemptckrealloc(VS(p),n)) +#define MALLOC(n) ((void*)(attemptckalloc(n))) +#define FREE(p) ckfree((void*)(p)) +#define REALLOC(p,n) ((void*)(attemptckrealloc((void*)(p),n))) /* * Do not insert extras between the "begin" and "end" lines - this chunk is @@ -60,12 +59,6 @@ #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif -#ifdef __REG_VOID_T -#undef __REG_VOID_T -#endif -#ifdef __REG_CONST -#undef __REG_CONST -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -75,8 +68,6 @@ /* Interface types */ #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 9466fbb..1e6cea8 100644 --- a/generic/regex.h +++ b/generic/regex.h @@ -92,12 +92,6 @@ extern "C" { #ifdef __REG_REGOFF_T #undef __REG_REGOFF_T #endif -#ifdef __REG_VOID_T -#undef __REG_VOID_T -#endif -#ifdef __REG_CONST -#undef __REG_CONST -#endif #ifdef __REG_NOFRONT #undef __REG_NOFRONT #endif @@ -107,8 +101,6 @@ extern "C" { /* interface types */ #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 @@ -134,26 +126,6 @@ typedef long regoff_t; #endif /* - * For benefit of old compilers, we offer <sys/types.h> the option of - * overriding the `void' type used to declare nonexistent return types. - */ -#ifdef __REG_VOID_T -typedef __REG_VOID_T re_void; -#else -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 +169,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 +200,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 */ @@ -248,7 +220,7 @@ typedef struct { /* * misc generics (may be more functions here eventually) - ^ re_void regfree(regex_t *); + ^ void regfree(regex_t *); */ /* @@ -260,7 +232,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 */ @@ -293,25 +265,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 void regfree(regex_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/regexec.c b/generic/regexec.c index ad4b6e6..e65a02b 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -44,7 +44,7 @@ struct sset { /* state set */ unsigned hash; /* hash of bitvector */ #define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw)) #define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \ - memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0)) + memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0)) int flags; #define STARTER 01 /* the initial state set */ #define POSTSTATE 02 /* includes the goal state */ @@ -276,7 +276,7 @@ exec( if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) { zapSubexpressions(pmatch, nmatch); n = (nmatch < v->nmatch) ? nmatch : v->nmatch; - memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t)); + memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t)); } /* diff --git a/generic/regguts.h b/generic/regguts.h index b478e4c..5c68a31 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -49,41 +49,15 @@ #include <assert.h> #endif -/* voids */ -#ifndef VOID -#define VOID void /* for function return values */ -#endif -#ifndef DISCARD -#define DISCARD void /* for throwing values away */ -#endif -#ifndef PVOID -#define PVOID void * /* generic pointer */ -#endif -#ifndef VS -#define VS(x) ((void*)(x)) /* cast something to generic ptr */ -#endif -#ifndef NOPARMS -#define NOPARMS void /* for empty parm lists */ -#endif - -/* function-pointer declarator */ -#ifndef FUNCPTR -#if __STDC__ >= 1 -#define FUNCPTR(name, args) (*name)args -#else -#define FUNCPTR(name, args) (*name)() -#endif -#endif - /* memory allocation */ #ifndef MALLOC #define MALLOC(n) malloc(n) #endif #ifndef REALLOC -#define REALLOC(p, n) realloc(VS(p), n) +#define REALLOC(p, n) realloc((void*)(p), n) #endif #ifndef FREE -#define FREE(p) free(VS(p)) +#define FREE(p) free((void*)(p)) #endif /* want size of a char in bits, and max value in bounded quantifiers */ @@ -367,7 +341,7 @@ struct subre { */ struct fns { - void FUNCPTR(free, (regex_t *)); + void (*free)(regex_t *); }; /* @@ -384,7 +358,7 @@ struct guts { struct cnfa search; /* for fast preliminary search */ int ntree; struct colormap cmap; - int FUNCPTR(compare, (const chr *, const chr *, size_t)); + int (*compare) (const chr *, const chr *, size_t); struct subre *lacons; /* lookahead-constraint vector */ int nlacons; /* size of lacons */ }; diff --git a/generic/tcl.decls b/generic/tcl.decls index 1829249..c1345cf 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -18,10 +18,12 @@ library tcl # tclPlat - platform specific public # tclInt - generic private # tclPlatInt - platform specific private +# tclOO - tclOO public +# tclOOInt - tclOO private interface tcl -hooks {tclPlat tclInt tclIntPlat} -scspec EXTERN +hooks {tclPlat tclInt tclIntPlat tclOO tclOOInt} +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 +34,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) } @@ -152,10 +154,11 @@ declare 35 { int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr) } -declare 36 { - int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr) -} +# Removed in 9.0 +#declare 36 { +# int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +# 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 +169,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) @@ -253,10 +256,11 @@ declare 65 { declare 66 { void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message) } -declare 67 { - void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, - int length) -} +# Removed in 9.0: +#declare 67 { +# void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message, +# int length) +#} declare 68 { void Tcl_AllowExceptions(Tcl_Interp *interp) } @@ -285,9 +289,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 +311,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 +323,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 +357,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,21 +466,23 @@ 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) -} -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) -} -declare 131 { - int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} + const char *Tcl_ErrnoMsg(int err) +} +# Removed in 9.0: +#declare 129 { +# int Tcl_Eval(Tcl_Interp *interp, const char *script) +#} +# Removed in 9.0: +#declare 130 { +# int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) +#} +# Removed in 9.0: +#declare 131 { +# int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} declare 132 { void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc) } @@ -514,9 +521,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 +537,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 +567,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 +631,25 @@ declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 { - CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp) -} -declare 175 { - CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, - int flags) + const char *Tcl_GetStringResult(Tcl_Interp *interp) } +# Removed in 9.0 +#declare 175 { +# 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 9.0 +#declare 177 { +# int Tcl_GlobalEval(Tcl_Interp *interp, const char *command) +#} +# Removed in 9.0 +#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 +674,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 +697,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 +715,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 +741,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 +777,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 +791,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) } @@ -814,9 +825,10 @@ declare 228 { declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } -declare 230 { - void Tcl_SetPanicProc(Tcl_PanicProc *panicProc) -} +# Removed (from stubtable only) in 9.0: +#declare 230 { +# void Tcl_SetPanicProc(Tcl_PanicProc *panicProc) +#} declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) } @@ -836,30 +848,31 @@ declare 235 { 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 *newValue, int flags) -} +# Removed in 9.0: +#declare 237 { +# 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,14 +881,15 @@ declare 244 { declare 245 { int Tcl_StringMatch(const char *str, const char *pattern) } -# Obsolete -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) -} +# Removed in Tcl 9 +#declare 246 { +# int Tcl_TellOld(Tcl_Channel chan) +#} +# Removed in Tcl 9 +#declare 247 { +# int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, ClientData clientData) +#} declare 248 { int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) @@ -893,17 +907,19 @@ declare 251 { declare 252 { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } -declare 253 { - int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) -} +# Removed in 9.0: +#declare 253 { +# int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags) +#} declare 254 { int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } -declare 255 { - void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, - Tcl_VarTraceProc *proc, ClientData clientData) -} +# Removed in 9.0: +#declare 255 { +# void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags, +# Tcl_VarTraceProc *proc, ClientData clientData) +#} declare 256 { void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, @@ -912,21 +928,24 @@ declare 256 { declare 257 { void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName) } -declare 258 { - int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, - const char *varName, const char *localName, int flags) -} +# Removed in 9.0 +#declare 258 { +# int Tcl_UpVar(Tcl_Interp *interp, const char *frameName, +# const char *varName, const char *localName, int flags) +#} declare 259 { int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags) } -declare 260 { - int Tcl_VarEval(Tcl_Interp *interp, ...) -} -declare 261 { - ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) -} +# Removed in 9.0 +#declare 260 { +# int Tcl_VarEval(Tcl_Interp *interp, ...) +#} +# Removed in 9.0 +#declare 261 { +# ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName, +# int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) +#} declare 262 { ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, @@ -955,33 +974,37 @@ declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { - CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, - CONST84 char **termPtr) -} -declare 271 { - CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, - const char *version, int exact) -} + const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr) +} +# Removed in 9.0, converted to macro +#declare 271 { +# 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) } +# Changed to a macro, only (internally) exposed for legacy protection. declare 273 { - int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, + int TclPkgProvide(Tcl_Interp *interp, const char *name, const char *version) } # 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 *version, int exact) -} +# Removed in 9.0, converted to macro +#declare 274 { +# const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, +# const char *version, int exact) +#} declare 275 { void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList) } -declare 276 { - int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) -} +# Removed in 9.0 +#declare 276 { +# int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList) +#} declare 277 { Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options) } @@ -1044,9 +1067,10 @@ declare 288 { declare 289 { void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData) } -declare 290 { - void Tcl_DiscardResult(Tcl_SavedResult *statePtr) -} +# Removed in 9.0: +#declare 290 { +# void Tcl_DiscardResult(Tcl_SavedResult *statePtr) +#} declare 291 { int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags) @@ -1087,7 +1111,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) @@ -1127,12 +1151,14 @@ declare 313 { int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag) } -declare 314 { - void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} -declare 315 { - void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) -} +# Removed in 9.0: +#declare 314 { +# void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} +# Removed in 9.0: +#declare 315 { +# void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr) +#} declare 316 { int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name) } @@ -1163,7 +1189,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 +1198,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 +1240,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) } @@ -1252,7 +1280,7 @@ declare 352 { } declare 353 { int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) + size_t numChars) } declare 354 { char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr, @@ -1266,10 +1294,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 +1308,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 +1321,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, @@ -1313,10 +1342,10 @@ declare 368 { int Tcl_Stat(const char *path, struct stat *bufPtr) } declare 369 { - int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 370 { - int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n) + int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } declare 371 { int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase) @@ -1408,7 +1437,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( @@ -1487,7 +1516,7 @@ declare 418 { } declare 419 { int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, - unsigned long numChars) + size_t numChars) } declare 420 { int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr, @@ -1548,14 +1577,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 +1646,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 +1724,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) @@ -2368,9 +2397,6 @@ declare 1 macosx { # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } diff --git a/generic/tcl.h b/generic/tcl.h index ab54078..02b4750 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_RELEASE_SERIAL 1 +#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.1" +#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,123 +213,17 @@ extern "C" { * be reset to DLLIMPORT. */ -#undef TCL_STORAGE_CLASS #ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT +# define TCLAPI extern 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 __VXWORKS__ -# ifndef NO_VOID -# define VOID void -# else -# define VOID char -# endif +# define TCLAPI extern 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 @@ -458,7 +333,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ #elif defined(__CYGWIN__) - typedef struct _stat32i64 { + typedef struct { dev_t st_dev; unsigned short st_ino; unsigned short st_mode; @@ -500,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_GetStringResult/Tcl_SetResult"); - /* If the last command returned a string - * result, this points to it. */ - void (*freeProc) (char *blockPtr) - TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult"); - /* Zero means the string result is statically - * allocated. TCL_DYNAMIC means it was - * allocated with ckalloc and should be freed - * with ckfree. Other values give the address - * of function to invoke to free the result. - * Tcl_Eval must free it before executing next - * command. */ -#else - char *resultDontUse; /* Don't use in extensions! */ - void (*freeProcDontUse) (char *); /* Don't use in extensions! */ -#endif -#ifdef USE_INTERP_ERRORLINE - int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine"); - /* When TCL_ERROR is returned, this gives the - * line number within the command where the - * error occurred (1 if first line). */ -#else - int errorLineDontUse; /* Don't use in extensions! */ -#endif -} -#endif /* TCL_NO_DEPRECATED */ -Tcl_Interp; +typedef struct Tcl_Interp Tcl_Interp; typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler; typedef struct Tcl_Channel_ *Tcl_Channel; @@ -681,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(): @@ -694,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: @@ -728,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); @@ -754,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); @@ -768,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, @@ -865,20 +690,11 @@ int Tcl_IsShared(Tcl_Obj *objPtr); /* *---------------------------------------------------------------------------- - * The following structure contains the state needed by Tcl_SaveResult. No-one - * outside of Tcl should access any of these fields. This structure is - * typically allocated on the stack. + * The following type contains the state needed by Tcl_SaveResult. This + * structure is typically allocated on the stack. */ -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; +typedef Tcl_Obj *Tcl_SavedResult; /* *---------------------------------------------------------------------------- @@ -1003,7 +819,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 @@ -1123,17 +938,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: */ @@ -1416,8 +1220,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) @@ -1491,14 +1295,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, @@ -1689,7 +1493,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); @@ -2379,9 +2183,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) @@ -2394,36 +2195,44 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp, */ const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version, - int exact); + int exact, const char *tclversion, int magic); const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char *version, int epoch, int revision); -/* - * When not using stubs, make it a macro. - */ - -#ifndef USE_TCL_STUBS +#ifdef USE_TCL_STUBS +#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE +# define Tcl_InitStubs(interp, version, exact) \ + (Tcl_InitStubs)((interp), (version), (exact)|(int)sizeof(size_t), \ + TCL_VERSION, TCL_STUB_MAGIC) +#else +# define Tcl_InitStubs(interp, version, exact) \ + (Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, 1|(int)sizeof(size_t), \ + TCL_VERSION, TCL_STUB_MAGIC) +#endif +#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_CreateInterp)())) -EXTERN void Tcl_MainEx(int argc, char **argv, +TCLAPI void Tcl_FindExecutable(const char *argv0); +TCLAPI void Tcl_SetPanicProc(Tcl_PanicProc *panicProc); +TCLAPI void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); -EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp, +#if defined(_WIN32) && defined(UNICODE) +TCLAPI void Tcl_MainExW(int argc, wchar_t **argv, + Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); +#endif +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 /* @@ -2501,11 +2310,15 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); /* * Use do/while0 idiom for optimum correctness without compiler warnings. * http://c2.com/cgi/wiki?TrivialDoWhileLoop + * + * Decrement refCount AFTER checking it for 0 or 1 (<2), because + * we cannot assume anymore that refCount is a signed type; In + * Tcl8 it was but in Tcl9 it is subject to change. */ # define Tcl_DecrRefCount(objPtr) \ do { \ Tcl_Obj *_objPtr = (objPtr); \ - if (--(_objPtr)->refCount <= 0) { \ + if (_objPtr->refCount-- < 2) { \ TclFreeObj(_objPtr); \ } \ } while(0) @@ -2532,9 +2345,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); # undef Tcl_NewDoubleObj # define Tcl_NewDoubleObj(val) \ Tcl_DbNewDoubleObj(val, __FILE__, __LINE__) -# undef Tcl_NewIntObj -# define Tcl_NewIntObj(val) \ - Tcl_DbNewLongObj(val, __FILE__, __LINE__) # undef Tcl_NewListObj # define Tcl_NewListObj(objc, objv) \ Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__) @@ -2598,35 +2408,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #define Tcl_ConditionFinalize(condPtr) #endif /* TCL_THREADS */ -/* - *---------------------------------------------------------------------------- - * Deprecated Tcl functions: - */ - -#ifndef TCL_NO_DEPRECATED -/* - * These function have been renamed. The old names are deprecated, but we - * define these macros for backwards compatibilty. - */ - -# 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/tclBasic.c b/generic/tclBasic.c index a41351e..b6e7227 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 @@ -133,8 +121,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); @@ -207,9 +193,6 @@ static const CmdInfo builtInCmds[] = { {"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE}, {"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE}, {"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE}, -#ifndef EXCLUDE_OBSOLETE_COMMANDS - {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, -#endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, {"concat", Tcl_ConcatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, @@ -516,9 +499,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); @@ -573,10 +559,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; @@ -604,7 +586,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 */ @@ -718,12 +699,6 @@ Tcl_CreateInterp(void) #endif /* TCL_COMPILE_STATS */ /* - * Initialise the stub table pointer. - */ - - iPtr->stubTable = &tclStubs; - - /* * Initialize the ensemble error message rewriting support. */ @@ -1509,7 +1484,6 @@ DeleteInterpProc( */ Tcl_FreeResult(interp); - iPtr->result = NULL; Tcl_DecrRefCount(iPtr->objResultPtr); iPtr->objResultPtr = NULL; Tcl_DecrRefCount(iPtr->ecVar); @@ -1531,10 +1505,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); @@ -2408,7 +2378,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_ObjCmdProc, @@ -2449,13 +2419,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. */ @@ -3387,360 +3350,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 @@ -3751,7 +3360,7 @@ Tcl_ListMathFuncs( * otherwise. * * Side effects: - * The interpreters object and string results are cleared. + * The interpreter's result is cleared. * *---------------------------------------------------------------------- */ @@ -3763,8 +3372,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); @@ -4343,24 +3952,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; @@ -4821,54 +4415,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 @@ -5802,81 +5348,6 @@ TclArgumentGet( /* *---------------------------------------------------------------------- * - * Tcl_Eval -- - * - * Execute a Tcl command in a string. This function executes the script - * directly, rather than compiling it to bytecodes. Before the arrival of - * the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used - * for executing Tcl commands, but nowadays it isn't used much. - * - * Results: - * The return value is one of the return codes defined in tcl.h (such as - * TCL_OK), and interp's result contains a value to supplement the return - * code. The value of the result will persist only until the next call to - * Tcl_Eval or Tcl_EvalObj: you must copy it or lose it! - * - * Side effects: - * Can be almost arbitrary, depending on the commands in the script. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_Eval -int -Tcl_Eval( - Tcl_Interp *interp, /* Token for command interpreter (returned by - * 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; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_EvalObj, Tcl_GlobalEvalObj -- - * - * These functions are deprecated but we keep them around for backwards - * compatibility reasons. - * - * Results: - * See the functions they call. - * - * Side effects: - * See the functions they call. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_EvalObj -int -Tcl_EvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, 0); -} -#undef Tcl_GlobalEvalObj -int -Tcl_GlobalEvalObj( - Tcl_Interp *interp, - Tcl_Obj *objPtr) -{ - return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_EvalObjEx, TclEvalObjEx -- * * Execute Tcl commands stored in a Tcl object. These commands are @@ -6259,9 +5730,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; } @@ -6288,9 +5756,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; } @@ -6316,14 +5781,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; } } @@ -6642,52 +6099,12 @@ Tcl_ExprString( Tcl_DecrRefCount(resultPtr); } } - - /* - * Force the string rep of the interp result. - */ - - (void) Tcl_GetStringResult(interp); return code; } /* *---------------------------------------------------------------------- * - * Tcl_AppendObjToErrorInfo -- - * - * Add a Tcl_Obj value to the errorInfo field that describes the current - * error. - * - * Results: - * None. - * - * Side effects: - * The value of the Tcl_obj is appended to the errorInfo field. If we are - * just starting to log an error, errorInfo is initialized from the error - * message in the interpreter's result. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_AddObjErrorInfo -void -Tcl_AppendObjToErrorInfo( - Tcl_Interp *interp, /* Interpreter to which error information - * pertains. */ - Tcl_Obj *objPtr) /* Message to record. */ -{ - int length; - const char *message = TclGetStringFromObj(objPtr, &length); - - Tcl_IncrRefCount(objPtr); - Tcl_AddObjErrorInfo(interp, message, length); - Tcl_DecrRefCount(objPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_AddErrorInfo -- * * Add information to the errorInfo field that describes the current @@ -6711,24 +6128,22 @@ Tcl_AddErrorInfo( * pertains. */ const char *message) /* Message to record. */ { - Tcl_AddObjErrorInfo(interp, message, -1); + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1)); } /* *---------------------------------------------------------------------- * - * Tcl_AddObjErrorInfo -- + * Tcl_AppendObjToErrorInfo -- * - * Add information to the errorInfo field that describes the current - * error. This routine differs from Tcl_AddErrorInfo by taking a byte - * pointer and length. + * Add a Tcl_Obj value to the errorInfo field that describes the current + * error. * * Results: * None. * * Side effects: - * "length" bytes from "message" are appended to the errorInfo field. If - * "length" is negative, use bytes up to the first NULL byte. If we are + * The value of the Tcl_obj is appended to the errorInfo field. If we are * just starting to log an error, errorInfo is initialized from the error * message in the interpreter's result. * @@ -6736,15 +6151,16 @@ Tcl_AddErrorInfo( */ void -Tcl_AddObjErrorInfo( +Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - const char *message, /* Points to the first byte of an array of - * bytes of the message. */ - int length) /* The number of bytes in the message. If < 0, - * then append all bytes up to a NULL byte. */ + Tcl_Obj *objPtr) /* Message to record. */ { + int length; register Interp *iPtr = (Interp *) interp; + const char *message = TclGetStringFromObj(objPtr, &length); + + Tcl_IncrRefCount(objPtr); /* * If we are just starting to log an error, errorInfo is initialized from @@ -6753,19 +6169,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); @@ -6784,123 +6188,7 @@ Tcl_AddObjErrorInfo( } Tcl_AppendToObj(iPtr->errorInfo, message, length); } -} - -/* - *--------------------------------------------------------------------------- - * - * Tcl_VarEvalVA -- - * - * Given a variable number of string arguments, concatenate them all - * together and execute the result as a Tcl command. - * - * Results: - * A standard Tcl return result. An error message or other result may be - * left in the interp's result. - * - * Side effects: - * Depends on what was done by the command. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_VarEvalVA( - Tcl_Interp *interp, /* Interpreter in which to evaluate command */ - va_list argList) /* Variable argument list. */ -{ - Tcl_DString buf; - char *string; - int result; - - /* - * Copy the strings one after the other into a single larger string. Use - * stack-allocated space for small commands, but if the command gets too - * large than call ckalloc to create the space. - */ - - Tcl_DStringInit(&buf); - while (1) { - string = va_arg(argList, char *); - if (string == NULL) { - break; - } - Tcl_DStringAppend(&buf, string, -1); - } - - result = Tcl_Eval(interp, Tcl_DStringValue(&buf)); - Tcl_DStringFree(&buf); - return result; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_VarEval -- - * - * Given a variable number of string arguments, concatenate them all - * together and execute the result as a Tcl command. - * - * Results: - * A standard Tcl return result. An error message or other result may be - * left in interp->result. - * - * Side effects: - * Depends on what was done by the command. - * - *---------------------------------------------------------------------- - */ - /* ARGSUSED */ -int -Tcl_VarEval( - Tcl_Interp *interp, - ...) -{ - va_list argList; - int result; - - va_start(argList, interp); - result = Tcl_VarEvalVA(interp, argList); - va_end(argList); - - return result; -} - -/* - *---------------------------------------------------------------------- - * - * 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. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_GlobalEval -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_DecrRefCount(objPtr); } /* diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 4e977f2..9bbc011 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -194,7 +194,7 @@ const Tcl_ObjType tclByteArrayType = { * fewer mallocs. */ -typedef struct ByteArray { +typedef struct { int used; /* The number of bytes used in the byte * array. */ int allocated; /* The amount of space actually allocated @@ -2368,8 +2368,8 @@ BinaryDecodeHex( return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { - if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -2490,8 +2490,8 @@ BinaryEncode64( return TCL_ERROR; } for (i = 1; i < objc-1; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -2710,8 +2710,8 @@ BinaryDecodeUu( return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { - if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -2874,8 +2874,8 @@ BinaryDecode64( return TCL_ERROR; } for (i = 1; i < objc-1; ++i) { - if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], optStrings, + sizeof(char *), "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 70e64f0..ede0d67 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -33,7 +33,7 @@ * "memory tag" command is invoked, to hold the current tag. */ -typedef struct MemTag { +typedef struct { int refCount; /* Number of mem_headers referencing this * tag. */ char string[1]; /* Actual size of string will be as large as diff --git a/generic/tclClock.c b/generic/tclClock.c index 6d2976d..98ca02d 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -91,7 +91,7 @@ static const char *const literals[] = { * Structure containing the client data for [clock] */ -typedef struct ClockClientData { +typedef struct { int refCount; /* Number of live references. */ Tcl_Obj **literals; /* Pool of object literals. */ } ClockClientData; @@ -100,7 +100,7 @@ typedef struct ClockClientData { * Structure containing the fields used in [clock format] and [clock scan] */ -typedef struct TclDateFields { +typedef struct { Tcl_WideInt seconds; /* Time expressed in seconds from the Posix * epoch */ Tcl_WideInt localSeconds; /* Local time expressed in nominal seconds @@ -548,8 +548,8 @@ ClockGetjuliandayfromerayearmonthdayObjCmd( } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK - || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, - &era) != TCL_OK + || Tcl_GetIndexFromObjStruct(interp, fieldPtr, eras, + sizeof(char *), "era", TCL_EXACT, &era) != TCL_OK || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK || TclGetIntFromObj(interp, fieldPtr, &fields.year) != TCL_OK @@ -638,8 +638,8 @@ ClockGetjuliandayfromerayearweekdayObjCmd( } dict = objv[1]; if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK - || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT, - &era) != TCL_OK + || Tcl_GetIndexFromObjStruct(interp, fieldPtr, eras, + sizeof(char *), "era", TCL_EXACT, &era) != TCL_OK || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK || TclGetIntFromObj(interp, fieldPtr, &fields.iso8601Year)!=TCL_OK @@ -1697,8 +1697,8 @@ ClockClicksObjCmd( case 1: break; case 2: - if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "switch", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], clicksSwitches, + sizeof(char *), "switch", 0, &index) != TCL_OK) { return TCL_ERROR; } break; @@ -1867,8 +1867,8 @@ ClockParseformatargsObjCmd( localeObj = litPtr[LIT_C]; timezoneObj = litPtr[LIT__NIL]; for (i = 2; i < objc; i+=2) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0, - &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "switch", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badSwitch", Tcl_GetString(objv[i]), NULL); return TCL_ERROR; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index f90819a..fd62ede 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -132,142 +132,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, *p; - - if (i == caseObjc-1) { - Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra case pattern with no body", -1)); - return TCL_ERROR; - } - - /* - * Check for special case of single pattern (no list) with no - * backslash sequences. - */ - - pat = TclGetString(caseObjv[i]); - for (p = pat; *p != '\0'; p++) { - if (TclIsSpaceProc(*p) || (*p == '\\')) { - break; - } - } - if (*p == '\0') { - if ((*pat == 'd') && (strcmp(pat, "default") == 0)) { - body = i + 1; - } - if (Tcl_StringMatch(stringPtr, pat)) { - body = i + 1; - goto match; - } - continue; - } - - /* - * Break up pattern lists, then check each of the patterns in the - * list. - */ - - result = Tcl_SplitList(interp, pat, &patObjc, &patObjv); - if (result != TCL_OK) { - return result; - } - for (j = 0; j < patObjc; j++) { - if (Tcl_StringMatch(stringPtr, patObjv[j])) { - body = i + 1; - break; - } - } - ckfree(patObjv); - if (j < patObjc) { - break; - } - } - - match: - if (body != -1) { - armPtr = caseObjv[body - 1]; - result = Tcl_EvalObjEx(interp, caseObjv[body], 0); - if (result == TCL_ERROR) { - Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"%.50s\" arm line %d)", - TclGetString(armPtr), Tcl_GetErrorLine(interp))); - } - return result; - } - - /* - * Nothing matched: return nothing. - */ - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_CatchObjCmd -- * * This object-based procedure is invoked to process the "catch" Tcl @@ -531,8 +395,8 @@ Tcl_EncodingObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -748,7 +612,7 @@ Tcl_EvalObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv); + return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, dummy, objc, objv); } int diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index fa4ead4..a4c422e 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -56,7 +56,7 @@ typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); * The following structure is used to pass this information. */ -typedef struct SortInfo { +typedef struct { int isIncreasing; /* Nonzero means sort in increasing order. */ int sortMode; /* The sort mode. One of SORTMODE_* values * defined below. */ @@ -2944,8 +2944,8 @@ Tcl_LsearchObjCmd( } for (i = 1; i < objc-2; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } @@ -3674,8 +3674,8 @@ Tcl_LsortObjCmd( groupOffset = 0; indexPtr = NULL; for (i = 1; i < objc-1; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], switches, + sizeof(char *), "option", 0, &index) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done2; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 5087fbb..5d1820c 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -159,8 +159,8 @@ Tcl_RegexpObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { goto optionError; } switch ((enum options) index) { @@ -335,7 +335,7 @@ Tcl_RegexpObjCmd( */ if (!doinline) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } return TCL_OK; } @@ -457,7 +457,7 @@ Tcl_RegexpObjCmd( if (doinline) { Tcl_SetObjResult(interp, resultPtr); } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(all ? all-1 : 1)); } return TCL_OK; } @@ -517,8 +517,8 @@ Tcl_RegsubObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch", - TCL_EXACT, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[idx], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { goto optionError; } switch ((enum options) index) { @@ -594,7 +594,7 @@ Tcl_RegsubObjCmd( */ int slen, nocase; - int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long); + int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p, wsrclc; numMatches = 0; @@ -629,7 +629,7 @@ Tcl_RegsubObjCmd( if ((*wstring == *wsrc || (nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) && (slen==1 || (strCmpFn(wstring, wsrc, - (unsigned long) slen) == 0))) { + (size_t)slen) == 0))) { if (numMatches == 0) { resultPtr = Tcl_NewUnicodeObj(wstring, 0); Tcl_IncrRefCount(resultPtr); @@ -847,7 +847,7 @@ Tcl_RegsubObjCmd( * holding the number of matches. */ - Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(numMatches)); } } else { /* @@ -1003,8 +1003,8 @@ TclNRSourceObjCmd( }; int index; - if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options, - "option", TCL_EXACT, &index)) { + if (TCL_ERROR == Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", TCL_EXACT, &index)) { return TCL_ERROR; } encodingName = TclGetString(objv[2]); @@ -1260,7 +1260,7 @@ StringFirstCmd( } str_first_done: - Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(match)); return TCL_OK; } @@ -1358,7 +1358,7 @@ StringLastCmd( } str_last_done: - Tcl_SetObjResult(interp, Tcl_NewIntObj(match)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(match)); return TCL_OK; } @@ -1485,8 +1485,8 @@ StringIsCmd( "class ?-strict? ?-failindex var? str"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], isClasses, + sizeof(char *), "class", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1494,8 +1494,8 @@ StringIsCmd( for (i = 2; i < objc-1; i++) { int idx2; - if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0, - &idx2) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], isOptions, + sizeof(char *), "option", 0, &idx2) != TCL_OK) { return TCL_ERROR; } switch ((enum isOptions) idx2) { @@ -1798,11 +1798,11 @@ StringIsCmd( str_is_done: if ((result == 0) && (failVarObj != NULL) && - Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat), + Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewLongObj(failat), TCL_LEAVE_ERR_MSG) == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(result!=0)); return TCL_OK; } @@ -1849,7 +1849,7 @@ StringMapCmd( int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long); + int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); @@ -1990,7 +1990,7 @@ StringMapCmd( if (((*ustring1 == *ustring2) || (nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) && (length2==1 || strCmpFn(ustring1, ustring2, - (unsigned long) length2) == 0)) { + (size_t) length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); p = ustring1 + length2; @@ -2038,7 +2038,7 @@ StringMapCmd( (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ (end-ustring1 >= length2) && ((length2 == 1) || - !strCmpFn(ustring2, ustring1, (unsigned) length2))) { + !strCmpFn(ustring2, ustring1, (size_t) length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. @@ -2137,8 +2137,8 @@ StringMatchCmd( return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj( - TclStringMatchObj(objv[objc-1], objv[objc-2], nocase))); + Tcl_SetObjResult(interp, Tcl_NewLongObj( + TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)!=0)); return TCL_OK; } @@ -2468,7 +2468,7 @@ StringStartCmd( cur += 1; } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(cur)); return TCL_OK; } @@ -2530,7 +2530,7 @@ StringEndCmd( } else { cur = numChars; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(cur)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(cur)); return TCL_OK; } @@ -2567,7 +2567,7 @@ StringEqualCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); + typedef int (*strCmpFn_t)(const char *, const char *, size_t); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2612,7 +2612,7 @@ StringEqualCmd( * Always match at 0 chars of if it is the same obj. */ - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); return TCL_OK; } @@ -2680,7 +2680,7 @@ StringEqualCmd( } } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(match==0)); return TCL_OK; } @@ -2717,7 +2717,7 @@ StringCmpCmd( const char *string1, *string2; int length1, length2, i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); + typedef int (*strCmpFn_t)(const char *, const char *, size_t); strCmpFn_t strCmpFn; if (objc < 3 || objc > 6) { @@ -2762,7 +2762,7 @@ StringCmpCmd( * Always match at 0 chars of if it is the same obj. */ - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; } @@ -2801,11 +2801,11 @@ StringCmpCmd( string1 = (char *) TclGetStringFromObj(objv[0], &length1); string2 = (char *) TclGetStringFromObj(objv[1], &length2); if ((reqlength < 0) && !nocase) { - strCmpFn = (strCmpFn_t) TclpUtfNcmp2; + strCmpFn = TclpUtfNcmp2; } else { length1 = Tcl_NumUtfChars(string1, length1); length2 = Tcl_NumUtfChars(string2, length2); - strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp); + strCmpFn = nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp; } } @@ -2821,13 +2821,13 @@ StringCmpCmd( reqlength = length + 1; } - match = strCmpFn(string1, string2, (unsigned) length); + match = strCmpFn(string1, string2, (size_t) length); if ((match == 0) && (reqlength > length)) { match = length1 - length2; } Tcl_SetObjResult(interp, - Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0)); + Tcl_NewLongObj((match > 0) ? 1 : (match < 0) ? -1 : 0)); return TCL_OK; } @@ -2865,7 +2865,7 @@ StringBytesCmd( } (void) TclGetStringFromObj(objv[1], &length); - Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(length)); return TCL_OK; } @@ -2899,7 +2899,7 @@ StringLenCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1]))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_GetCharLength(objv[1]))); return TCL_OK; } @@ -3389,8 +3389,8 @@ TclSubstOptions( for (i = 0; i < numOpts; i++) { int optionIndex; - if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "switch", 0, - &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, opts[i], substOptions, + sizeof(char *), "switch", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch (optionIndex) { @@ -3514,8 +3514,8 @@ TclNRSwitchObjCmd( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -3791,7 +3791,7 @@ TclNRSwitchObjCmd( rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start); rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1); } else { - rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1); + rangeObjAry[0] = rangeObjAry[1] = Tcl_NewLongObj(-1); } /* @@ -4111,7 +4111,7 @@ Tcl_TimeObjCmd( * Use int obj since we know time is not fractional. [Bug 1202178] */ - objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec); + objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : (int) totalMicroSec); } else { objs[0] = Tcl_NewDoubleObj(totalMicroSec/count); } @@ -4191,8 +4191,8 @@ TclNRTryObjCmd( int type; Tcl_Obj *info[5]; - if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type", - 0, &type) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], handlerNames, + sizeof(char *), "handler type", 0, &type) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } @@ -4265,7 +4265,7 @@ TclNRTryObjCmd( } info[0] = objv[i]; /* type */ - TclNewIntObj(info[1], code); /* returnCode */ + TclNewLongObj(info[1], code); /* returnCode */ if (info[2] == NULL) { /* errorCodePrefix */ TclNewObj(info[2]); } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 94c1bd6..a5b69a2 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -22,7 +22,7 @@ * The tree is composed of OpNodes. */ -typedef struct OpNode { +typedef struct { int left; /* "Pointer" to the left operand. */ int right; /* "Pointer" to the right operand. */ union { diff --git a/generic/tclCompile.h b/generic/tclCompile.h index a39e0f1..1f144b0 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -80,7 +80,7 @@ typedef enum { * to a catch PC offset. */ } ExceptionRangeType; -typedef struct ExceptionRange { +typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ int nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range @@ -155,7 +155,7 @@ typedef struct ExceptionAux { * source offset is not monotonic. */ -typedef struct CmdLocation { +typedef struct { int codeOffset; /* Offset of first byte of command code. */ int numCodeBytes; /* Number of bytes for command's code. */ int srcOffset; /* Offset of first char of the command. */ @@ -173,7 +173,7 @@ typedef struct CmdLocation { * frame and associated information, like the path of a sourced file. */ -typedef struct ECL { +typedef struct { int srcOffset; /* Command location to find the entry. */ int nline; /* Number of words in the command */ int *line; /* Line information for all words in the @@ -183,7 +183,7 @@ typedef struct ECL { * lines. */ } ECL; -typedef struct ExtCmdLoc { +typedef struct { int type; /* Context type. */ int start; /* Starting line for compiled script. Needed * for the extended recompile check in diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 2fb3e92..07f569a 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -31,7 +31,7 @@ * the (Tcl_Interp *) in which it is stored, and the encoding. */ -typedef struct QCCD { +typedef struct { Tcl_Obj *pkg; Tcl_Interp *interp; char *encoding; @@ -217,8 +217,8 @@ QueryConfigObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmdStrings, + sizeof(char *), "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 830c998..6074c98 100644..100755 --- 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 @@ -40,1779 +29,1705 @@ extern "C" { */ /* 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, - const char *msg, int flags, int *indexPtr); +/* Slot 36 is reserved */ /* 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, - const char *message, int length); +/* Slot 67 is reserved */ /* 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); -/* 129 */ -EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); -/* 130 */ -EXTERN int Tcl_EvalFile(Tcl_Interp *interp, - const char *fileName); -/* 131 */ -EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); +TCLAPI const char * Tcl_ErrnoMsg(int err); +/* Slot 129 is reserved */ +/* Slot 130 is reserved */ +/* Slot 131 is reserved */ /* 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); -/* 175 */ -EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, - const char *varName, int flags); +TCLAPI const char * Tcl_GetStringResult(Tcl_Interp *interp); +/* Slot 175 is reserved */ /* 176 */ -EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, - int flags); -/* 177 */ -EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, - const char *command); -/* 178 */ -EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); +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); -/* 230 */ -EXTERN void Tcl_SetPanicProc(Tcl_PanicProc *panicProc); +TCLAPI void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); +/* Slot 230 is reserved */ /* 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); -/* 237 */ -EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, - const char *varName, const char *newValue, - int flags); +TCLAPI void Tcl_SetStdChannel(Tcl_Channel channel, int type); +/* Slot 237 is reserved */ /* 238 */ -EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, - const char *newValue, int flags); +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); -/* 247 */ -EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, - int flags, Tcl_VarTraceProc *proc, - ClientData clientData); +TCLAPI int Tcl_StringMatch(const char *str, const char *pattern); +/* Slot 246 is reserved */ +/* Slot 247 is reserved */ /* 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, - int flags); +/* Slot 253 is reserved */ /* 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, - const char *varName, int flags, - Tcl_VarTraceProc *proc, - ClientData clientData); +/* Slot 255 is reserved */ /* 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, - const char *varName, const char *localName, - int flags); +/* Slot 258 is reserved */ /* 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, ...); -/* 261 */ -EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, - const char *varName, int flags, - Tcl_VarTraceProc *procPtr, - ClientData prevClientData); +/* Slot 260 is reserved */ +/* Slot 261 is reserved */ /* 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); -/* 271 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +TCLAPI const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr); +/* Slot 271 is reserved */ /* 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 TclPkgProvide(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); +/* Slot 274 is reserved */ /* 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); +/* Slot 276 is reserved */ /* 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); +/* Slot 290 is reserved */ /* 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, - Tcl_SavedResult *statePtr); -/* 315 */ -EXTERN void Tcl_SaveResult(Tcl_Interp *interp, - Tcl_SavedResult *statePtr); +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ /* 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, - const Tcl_UniChar *uct, - unsigned long numChars); +TCLAPI int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t 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, - unsigned long n); +TCLAPI int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 370 */ -EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, - unsigned long n); +TCLAPI int Tcl_UtfNcasecmp(const char *s1, const char *s2, + size_t 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, - const Tcl_UniChar *uct, - unsigned long numChars); +TCLAPI int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t 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); @@ -1820,6 +1735,8 @@ typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; + const struct TclOOStubs *tclOOStubs; + const struct TclOOIntStubs *tclOOIntStubs; } TclStubHooks; typedef struct TclStubs { @@ -1827,7 +1744,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 */ @@ -1878,11 +1795,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 */ + void (*reserved36)(void); 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 */ @@ -1909,7 +1826,7 @@ typedef struct TclStubs { void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */ void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */ void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */ - void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */ + void (*reserved67)(void); void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */ void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */ void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */ @@ -1919,16 +1836,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 */ @@ -1937,7 +1854,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 */ @@ -1969,11 +1886,11 @@ 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 */ - int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */ - int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ - int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */ + const char * (*tcl_ErrnoId) (void); /* 127 */ + const char * (*tcl_ErrnoMsg) (int err); /* 128 */ + void (*reserved129)(void); + void (*reserved130)(void); + void (*reserved131)(void); void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ void (*tcl_Exit) (int status); /* 133 */ int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */ @@ -1986,25 +1903,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 */ @@ -2024,11 +1941,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 */ + void (*reserved175)(void); + 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 */ @@ -2036,25 +1953,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 */ @@ -2065,12 +1982,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 */ @@ -2080,38 +1997,38 @@ typedef struct TclStubs { void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ - void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */ + void (*reserved230)(void); int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ int (*tcl_SetServiceMode) (int mode); /* 233 */ 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 */ + void (*reserved237)(void); + 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 */ - int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */ + void (*reserved246)(void); + void (*reserved247)(void); 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 */ int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */ void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */ int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */ - int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */ + void (*reserved253)(void); int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */ - void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */ + void (*reserved255)(void); void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */ void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */ - int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */ + void (*reserved258)(void); int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */ - int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */ - ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */ + void (*reserved260)(void); + void (*reserved261)(void); ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */ int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */ void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */ @@ -2120,13 +2037,13 @@ 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 */ - 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_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ + void (*reserved271)(void); + const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ + int (*tclPkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ + void (*reserved274)(void); void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ - int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ + void (*reserved276)(void); Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */ void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ @@ -2140,7 +2057,7 @@ typedef struct TclStubs { Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */ void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */ - void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */ + void (*reserved290)(void); int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ @@ -2152,7 +2069,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 */ @@ -2164,8 +2081,8 @@ typedef struct TclStubs { void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */ int (*tcl_NumUtfChars) (const char *src, int length); /* 312 */ int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */ - void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */ - void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */ + void (*reserved314)(void); + void (*reserved315)(void); int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */ Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */ void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */ @@ -2175,13 +2092,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 */ @@ -2191,8 +2108,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,24 +2120,24 @@ typedef struct TclStubs { int (*tcl_UniCharIsUpper) (int ch); /* 350 */ int (*tcl_UniCharIsWordChar) (int ch); /* 351 */ int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */ - int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */ + int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 353 */ 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 */ int (*tcl_Access) (const char *path, int mode); /* 367 */ int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */ - int (*tcl_UtfNcmp) (const char *s1, const char *s2, unsigned long n); /* 369 */ - int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, unsigned long n); /* 370 */ + int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */ + int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */ int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */ int (*tcl_UniCharIsControl) (int ch); /* 372 */ int (*tcl_UniCharIsGraph) (int ch); /* 373 */ @@ -2248,7 +2165,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 */ @@ -2269,7 +2186,7 @@ typedef struct TclStubs { void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */ void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */ int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */ - int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 419 */ + int (*tcl_UniCharNcasecmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, size_t numChars); /* 419 */ int (*tcl_UniCharCaseMatch) (const Tcl_UniChar *uniStr, const Tcl_UniChar *uniPattern, int nocase); /* 420 */ Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, const void *key); /* 421 */ Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, const void *key, int *newPtr); /* 422 */ @@ -2285,8 +2202,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 */ @@ -2303,7 +2220,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 */ @@ -2327,7 +2244,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 */ @@ -2579,8 +2496,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetDouble) /* 34 */ #define Tcl_GetDoubleFromObj \ (tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */ -#define Tcl_GetIndexFromObj \ - (tclStubsPtr->tcl_GetIndexFromObj) /* 36 */ +/* Slot 36 is reserved */ #define Tcl_GetInt \ (tclStubsPtr->tcl_GetInt) /* 37 */ #define Tcl_GetIntFromObj \ @@ -2641,8 +2557,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetStringObj) /* 65 */ #define Tcl_AddErrorInfo \ (tclStubsPtr->tcl_AddErrorInfo) /* 66 */ -#define Tcl_AddObjErrorInfo \ - (tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */ +/* Slot 67 is reserved */ #define Tcl_AllowExceptions \ (tclStubsPtr->tcl_AllowExceptions) /* 68 */ #define Tcl_AppendElement \ @@ -2661,8 +2576,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 \ @@ -2697,8 +2611,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,12 +2678,9 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_ErrnoId) /* 127 */ #define Tcl_ErrnoMsg \ (tclStubsPtr->tcl_ErrnoMsg) /* 128 */ -#define Tcl_Eval \ - (tclStubsPtr->tcl_Eval) /* 129 */ -#define Tcl_EvalFile \ - (tclStubsPtr->tcl_EvalFile) /* 130 */ -#define Tcl_EvalObj \ - (tclStubsPtr->tcl_EvalObj) /* 131 */ +/* Slot 129 is reserved */ +/* Slot 130 is reserved */ +/* Slot 131 is reserved */ #define Tcl_EventuallyFree \ (tclStubsPtr->tcl_EventuallyFree) /* 132 */ #define Tcl_Exit \ @@ -2795,8 +2705,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 \ @@ -2863,14 +2772,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetStdChannel) /* 173 */ #define Tcl_GetStringResult \ (tclStubsPtr->tcl_GetStringResult) /* 174 */ -#define Tcl_GetVar \ - (tclStubsPtr->tcl_GetVar) /* 175 */ +/* Slot 175 is reserved */ #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 \ @@ -2952,8 +2858,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 \ @@ -2972,8 +2877,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetErrorCode) /* 228 */ #define Tcl_SetMaxBlockTime \ (tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */ -#define Tcl_SetPanicProc \ - (tclStubsPtr->tcl_SetPanicProc) /* 230 */ +/* Slot 230 is reserved */ #define Tcl_SetRecursionLimit \ (tclStubsPtr->tcl_SetRecursionLimit) /* 231 */ #define Tcl_SetResult \ @@ -2986,8 +2890,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_SetObjResult) /* 235 */ #define Tcl_SetStdChannel \ (tclStubsPtr->tcl_SetStdChannel) /* 236 */ -#define Tcl_SetVar \ - (tclStubsPtr->tcl_SetVar) /* 237 */ +/* Slot 237 is reserved */ #define Tcl_SetVar2 \ (tclStubsPtr->tcl_SetVar2) /* 238 */ #define Tcl_SignalId \ @@ -3004,10 +2907,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_StaticPackage) /* 244 */ #define Tcl_StringMatch \ (tclStubsPtr->tcl_StringMatch) /* 245 */ -#define Tcl_TellOld \ - (tclStubsPtr->tcl_TellOld) /* 246 */ -#define Tcl_TraceVar \ - (tclStubsPtr->tcl_TraceVar) /* 247 */ +/* Slot 246 is reserved */ +/* Slot 247 is reserved */ #define Tcl_TraceVar2 \ (tclStubsPtr->tcl_TraceVar2) /* 248 */ #define Tcl_TranslateFileName \ @@ -3018,24 +2919,19 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_UnlinkVar) /* 251 */ #define Tcl_UnregisterChannel \ (tclStubsPtr->tcl_UnregisterChannel) /* 252 */ -#define Tcl_UnsetVar \ - (tclStubsPtr->tcl_UnsetVar) /* 253 */ +/* Slot 253 is reserved */ #define Tcl_UnsetVar2 \ (tclStubsPtr->tcl_UnsetVar2) /* 254 */ -#define Tcl_UntraceVar \ - (tclStubsPtr->tcl_UntraceVar) /* 255 */ +/* Slot 255 is reserved */ #define Tcl_UntraceVar2 \ (tclStubsPtr->tcl_UntraceVar2) /* 256 */ #define Tcl_UpdateLinkedVar \ (tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */ -#define Tcl_UpVar \ - (tclStubsPtr->tcl_UpVar) /* 258 */ +/* Slot 258 is reserved */ #define Tcl_UpVar2 \ (tclStubsPtr->tcl_UpVar2) /* 259 */ -#define Tcl_VarEval \ - (tclStubsPtr->tcl_VarEval) /* 260 */ -#define Tcl_VarTraceInfo \ - (tclStubsPtr->tcl_VarTraceInfo) /* 261 */ +/* Slot 260 is reserved */ +/* Slot 261 is reserved */ #define Tcl_VarTraceInfo2 \ (tclStubsPtr->tcl_VarTraceInfo2) /* 262 */ #define Tcl_Write \ @@ -3054,18 +2950,15 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_HashStats) /* 269 */ #define Tcl_ParseVar \ (tclStubsPtr->tcl_ParseVar) /* 270 */ -#define Tcl_PkgPresent \ - (tclStubsPtr->tcl_PkgPresent) /* 271 */ +/* Slot 271 is reserved */ #define Tcl_PkgPresentEx \ (tclStubsPtr->tcl_PkgPresentEx) /* 272 */ -#define Tcl_PkgProvide \ - (tclStubsPtr->tcl_PkgProvide) /* 273 */ -#define Tcl_PkgRequire \ - (tclStubsPtr->tcl_PkgRequire) /* 274 */ +#define TclPkgProvide \ + (tclStubsPtr->tclPkgProvide) /* 273 */ +/* Slot 274 is reserved */ #define Tcl_SetErrorCodeVA \ (tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */ -#define Tcl_VarEvalVA \ - (tclStubsPtr->tcl_VarEvalVA) /* 276 */ +/* Slot 276 is reserved */ #define Tcl_WaitPid \ (tclStubsPtr->tcl_WaitPid) /* 277 */ #define Tcl_PanicVA \ @@ -3091,8 +2984,7 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ (tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */ -#define Tcl_DiscardResult \ - (tclStubsPtr->tcl_DiscardResult) /* 290 */ +/* Slot 290 is reserved */ #define Tcl_EvalEx \ (tclStubsPtr->tcl_EvalEx) /* 291 */ #define Tcl_EvalObjv \ @@ -3139,10 +3031,8 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NumUtfChars) /* 312 */ #define Tcl_ReadChars \ (tclStubsPtr->tcl_ReadChars) /* 313 */ -#define Tcl_RestoreResult \ - (tclStubsPtr->tcl_RestoreResult) /* 314 */ -#define Tcl_SaveResult \ - (tclStubsPtr->tcl_SaveResult) /* 315 */ +/* Slot 314 is reserved */ +/* Slot 315 is reserved */ #define Tcl_SetSystemEncoding \ (tclStubsPtr->tcl_SetSystemEncoding) /* 316 */ #define Tcl_SetVar2Ex \ @@ -3193,10 +3083,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 \ @@ -3225,8 +3113,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 \ @@ -3381,10 +3268,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 \ @@ -3783,17 +3668,12 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_FindExecutable # undef Tcl_GetStringResult # undef Tcl_Init -# undef Tcl_SetPanicProc -# undef Tcl_SetVar # undef Tcl_ObjSetVar2 # 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_ObjSetVar2(interp, part1, part2, newValue, flags) \ (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags)) #endif @@ -3801,29 +3681,21 @@ extern const TclStubs *tclStubsPtr; #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, - Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - -#undef Tcl_SeekOld -#undef Tcl_TellOld - -#undef Tcl_PkgPresent #define Tcl_PkgPresent(interp, name, version, exact) \ Tcl_PkgPresentEx(interp, name, version, exact, NULL) -#undef Tcl_PkgProvide #define Tcl_PkgProvide(interp, name, version) \ Tcl_PkgProvideEx(interp, name, version, NULL) -#undef Tcl_PkgRequire #define Tcl_PkgRequire(interp, name, version, exact) \ Tcl_PkgRequireEx(interp, name, version, exact, NULL) -#undef Tcl_GetIndexFromObj +#define Tcl_Eval(interp,objPtr) \ + Tcl_EvalEx((interp),(objPtr),-1,0) +#define Tcl_GlobalEval(interp,objPtr) \ + Tcl_EvalEx((interp),(objPtr),-1,TCL_EVAL_GLOBAL) #define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ - Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \ - sizeof(char *), msg, flags, indexPtr) + Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \ + sizeof(char *), (msg), (flags), (indexPtr)) #undef Tcl_NewBooleanObj #define Tcl_NewBooleanObj(boolValue) \ Tcl_NewIntObj((boolValue)!=0) @@ -3833,25 +3705,37 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_SetBooleanObj #define Tcl_SetBooleanObj(objPtr, boolValue) \ Tcl_SetIntObj((objPtr), (boolValue)!=0) -#undef Tcl_SetVar +#undef Tcl_AddErrorInfo +#define Tcl_AddErrorInfo(interp, message) \ + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1)) +#define Tcl_AddObjErrorInfo(interp, message, length) \ + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), length)) +#define Tcl_SaveResult(interp, statePtr) \ + do { \ + *(statePtr) = Tcl_GetObjResult(interp); \ + Tcl_IncrRefCount(*(statePtr)); \ + Tcl_SetObjResult((interp), Tcl_NewObj()); \ + } while(0) +#define Tcl_RestoreResult(interp, statePtr) \ + do { \ + Tcl_ResetResult(interp); \ + Tcl_SetObjResult((interp), *(statePtr)); \ + Tcl_DecrRefCount(*(statePtr)); \ + } while(0) +#define Tcl_DiscardResult(statePtr) \ + Tcl_DecrRefCount(*(statePtr)) #define Tcl_SetVar(interp, varName, newValue, flags) \ Tcl_SetVar2(interp, varName, NULL, newValue, flags) -#undef Tcl_UnsetVar #define Tcl_UnsetVar(interp, varName, flags) \ Tcl_UnsetVar2(interp, varName, NULL, flags) -#undef Tcl_GetVar #define Tcl_GetVar(interp, varName, flags) \ Tcl_GetVar2(interp, varName, NULL, flags) -#undef Tcl_TraceVar #define Tcl_TraceVar(interp, varName, flags, proc, clientData) \ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData) -#undef Tcl_UntraceVar #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) -#undef Tcl_VarTraceInfo #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) -#undef Tcl_UpVar #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) @@ -3870,10 +3754,6 @@ extern const TclStubs *tclStubsPtr; # undef Tcl_SetLongObj # undef Tcl_ExprLong # undef Tcl_ExprLongObj -# undef Tcl_UniCharNcmp -# undef Tcl_UtfNcmp -# undef Tcl_UtfNcasecmp -# undef Tcl_UniCharNcasecmp # define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj) # define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj) # define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj) @@ -3892,14 +3772,6 @@ extern const TclStubs *tclStubsPtr; if (result == TCL_OK) *ptr = (long)intValue; return result; } -# define Tcl_UniCharNcmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n)) -# define Tcl_UtfNcmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UtfNcasecmp(s1,s2,n) \ - ((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n)) -# define Tcl_UniCharNcasecmp(ucs,uct,n) \ - ((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n)) # endif #endif @@ -3907,11 +3779,11 @@ extern const TclStubs *tclStubsPtr; * Deprecated Tcl procedures: */ -#undef Tcl_EvalObj -#define Tcl_EvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),0) -#undef Tcl_GlobalEvalObj -#define Tcl_GlobalEvalObj(interp,objPtr) \ - Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) +#ifndef TCL_NO_DEPRECATED +# define Tcl_EvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),0) +# define Tcl_GlobalEvalObj(interp,objPtr) \ + Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL) +#endif /* !TCL_NO_DEPRECATED */ #endif /* _TCLDECLS */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index e31d708..ad24017 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -485,15 +485,14 @@ static void UpdateStringOfDict( Tcl_Obj *dictPtr) { -#define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr = NULL; +#define LOCAL_SIZE 64 + char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; int i, length, bytesNeeded = 0; const char *elem; char *dst; - const int maxFlags = UINT_MAX / sizeof(int); /* * This field is the most useful one in the whole hash structure, and it @@ -515,10 +514,8 @@ UpdateStringOfDict( if (numElems <= LOCAL_SIZE) { flagPtr = localFlags; - } else if (numElems > maxFlags) { - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { - flagPtr = ckalloc(numElems * sizeof(int)); + flagPtr = ckalloc(numElems); } for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) { /* @@ -622,7 +619,7 @@ SetDictFromAny( } for (i=0 ; i<objc ; i+=2) { - + /* Store key and value in the hash table we're building. */ hPtr = CreateChainEntry(dict, objv[i], &isNew); if (!isNew) { @@ -1972,7 +1969,7 @@ DictSizeCmd( } result = Tcl_DictObjSize(interp, objv[1], &size); if (result == TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(size)); } return result; } @@ -2014,9 +2011,9 @@ DictExistsCmd( if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT || Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) { - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } else { - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(valuePtr != NULL)); } return TCL_OK; } @@ -2155,7 +2152,7 @@ DictIncrCmd( Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]); } } else { - Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1)); + Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewLongObj(1)); } } else { /* @@ -2169,7 +2166,7 @@ DictIncrCmd( if (objc == 4) { code = TclIncrObj(interp, valuePtr, objv[3]); } else { - Tcl_Obj *incrPtr = Tcl_NewIntObj(1); + Tcl_Obj *incrPtr = Tcl_NewLongObj(1); Tcl_IncrRefCount(incrPtr); code = TclIncrObj(interp, valuePtr, incrPtr); @@ -2914,8 +2911,8 @@ DictFilterCmd( Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", - 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], filters, + sizeof(char *), "filterType", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 2cc55d6..27a443f 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src); * convert between various character sets and UTF-8. */ -typedef struct Encoding { +typedef struct { char *name; /* Name of encoding. Malloced because (1) hash * table entry that owns this encoding may be * freed prior to this encoding being freed, @@ -57,7 +57,7 @@ typedef struct Encoding { * encoding. */ -typedef struct TableEncodingData { +typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ @@ -91,7 +91,7 @@ typedef struct TableEncodingData { * for switching character sets. */ -typedef struct EscapeSubTable { +typedef struct { unsigned sequenceLen; /* Length of following string. */ char sequence[16]; /* Escape code that marks this encoding. */ char name[32]; /* Name for encoding. */ @@ -100,7 +100,7 @@ typedef struct EscapeSubTable { * yet. */ } EscapeSubTable; -typedef struct EscapeEncodingData { +typedef struct { int fallback; /* Character (in this encoding) to substitute * when this encoding cannot represent a UTF-8 * character. */ @@ -672,68 +672,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 9bb7a0c..c71fad0 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -149,8 +149,8 @@ TclNamespaceEnsembleCmd( Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands, - "subcommand", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], ensembleSubcommands, + sizeof(char *), "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -194,8 +194,8 @@ TclNamespaceEnsembleCmd( */ for (; objc>1 ; objc-=2,objv+=2) { - if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], ensembleCreateOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); } @@ -368,8 +368,8 @@ TclNamespaceEnsembleCmd( if (objc == 4) { Tcl_Obj *resultObj = NULL; /* silence gcc 4 warning */ - if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], ensembleConfigOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum EnsConfigOpts) index) { @@ -489,8 +489,8 @@ TclNamespaceEnsembleCmd( */ for (; objc>0 ; objc-=2,objv+=2) { - if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0],ensembleConfigOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { freeMapAndError: if (allocatedMapFlag) { Tcl_DecrRefCount(mapObj); diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 941d566..24bb96f 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -37,7 +37,7 @@ typedef struct BgError { * pending background errors for the interpreter. */ -typedef struct ErrAssocData { +typedef struct { Tcl_Interp *interp; /* Interpreter in which error occurred. */ Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */ BgError *firstBgPtr; /* First in list of all background errors @@ -891,7 +891,7 @@ Tcl_SetExitProc( *---------------------------------------------------------------------- */ static void -InvokeExitHandlers(void) +InvokeExitHandlers(void) { ExitHandler *exitPtr; @@ -967,22 +967,22 @@ Tcl_Exit( /* * Fast and deterministic exit (default behavior) */ - + InvokeExitHandlers(); - + /* * Ensure the thread-specific data is initialised as it is used in * Tcl_FinalizeThread() */ - + (void) TCL_TSD_INIT(&dataKey); - + /* * Now finalize the calling thread only (others are not safely * reachable). Among other things, this triggers a flush of the * Tcl_Channels that may have data enqueued. */ - + Tcl_FinalizeThread(); } TclpExit(status); @@ -1089,7 +1089,7 @@ Tcl_Finalize(void) * Invoke exit handlers first. */ - InvokeExitHandlers(); + InvokeExitHandlers(); TclpInitLock(); if (subsystemsInitialized == 0) { @@ -1491,8 +1491,8 @@ Tcl_UpdateObjCmd( if (objc == 1) { flags = TCL_ALL_EVENTS|TCL_DONT_WAIT; } else if (objc == 2) { - if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions, - "option", 0, &optionIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], updateOptions, + sizeof(char *), "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; } switch ((enum updateOptions) optionIndex) { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d3c1227..eb09213 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 @@ -171,7 +114,7 @@ static BuiltinFunc const tclBuiltinFuncTable[] = { * Minimal data required to fully reconstruct the execution state. */ -typedef struct TEBCdata { +typedef struct { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ const unsigned char *pc; /* These fields are used on return TO this */ @@ -876,9 +819,9 @@ TclCreateExecEnv( + (size_t) (size-1) * sizeof(Tcl_Obj *)); eePtr->execStackPtr = esPtr; - TclNewBooleanObj(eePtr->constants[0], 0); + TclNewLongObj(eePtr->constants[0], 0); Tcl_IncrRefCount(eePtr->constants[0]); - TclNewBooleanObj(eePtr->constants[1], 1); + TclNewLongObj(eePtr->constants[1], 1); Tcl_IncrRefCount(eePtr->constants[1]); eePtr->interp = interp; eePtr->callbackPtr = NULL; @@ -2911,90 +2854,15 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else /* * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. + * changes to add a ::tcl::mathfunc namespace in 8.5. */ 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); @@ -4357,7 +4225,7 @@ TEBCresume( NEXT_INST_F(1, 0, 1); } case INST_INFO_LEVEL_NUM: - TclNewIntObj(objResultPtr, iPtr->varFramePtr->level); + TclNewLongObj(objResultPtr, iPtr->varFramePtr->level); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); case INST_INFO_LEVEL_ARGS: { @@ -4486,7 +4354,7 @@ TEBCresume( Tcl_GetObjResult(interp)); goto gotError; } - TclNewIntObj(objResultPtr, length); + TclNewLongObj(objResultPtr, length); TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); @@ -4976,7 +4844,7 @@ TEBCresume( } } if (match < 0) { - TclNewIntObj(objResultPtr, -1); + TclNewLongObj(objResultPtr, -1); } else { objResultPtr = TCONST(match > 0); } @@ -4987,7 +4855,7 @@ TEBCresume( case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); - TclNewIntObj(objResultPtr, length); + TclNewLongObj(objResultPtr, length); TRACE(("%.20s => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); @@ -5175,7 +5043,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); + TclNewLongObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: @@ -5196,7 +5064,7 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); + TclNewLongObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); } @@ -5536,7 +5404,7 @@ TEBCresume( if (l1 > 0L) { objResultPtr = TCONST(0); } else { - TclNewIntObj(objResultPtr, -1); + TclNewLongObj(objResultPtr, -1); } TRACE(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); @@ -5734,16 +5602,6 @@ TEBCresume( w2 = (Tcl_WideInt) l2; wResult = w1 - w2; #ifdef TCL_WIDE_INT_IS_LONG - /* - * Must check for overflow. The macro tests for overflows in - * sums by looking at the sign bits. As we have a subtraction - * here, we are adding -w2. As -w2 could in turn overflow, we - * test with ~w2 instead: it has the opposite sign bit to w2 - * so it does the job. Note that the only "bad" case (w2==0) - * is irrelevant for this macro, as in that case w1 and - * wResult have the same sign and there is no overflow anyway. - */ - if (Overflowing(w1, ~w2, wResult)) { goto overflow; } @@ -6218,7 +6076,7 @@ TEBCresume( NEXT_INST_F(1, 0, -1); case INST_PUSH_RETURN_CODE: - TclNewIntObj(objResultPtr, result); + TclNewLongObj(objResultPtr, result); TRACE(("=> %u\n", result)); NEXT_INST_F(1, 0, 1); @@ -8717,16 +8575,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) { @@ -8737,7 +8586,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); } diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 13377d3..26d3dc5 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -120,7 +120,7 @@ FileCopyRename( } i++; if ((objc - i) < 2) { - Tcl_WrongNumArgs(interp, 1, objv, + Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? source ?source ...? target"); return TCL_ERROR; } @@ -828,8 +828,8 @@ FileForceOption( if (TclGetString(objv[i])[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT, - &idx) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", TCL_EXACT, &idx) != TCL_OK) { return -1; } if (idx == 0 /* -force */) { @@ -1078,8 +1078,8 @@ TclFileAttrsCmd( goto end; } - if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[0], attributeStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { goto end; } if (attributeStringsAllocated != NULL) { @@ -1106,8 +1106,8 @@ TclFileAttrsCmd( } for (i = 0; i < objc ; i += 2) { - if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings, - "option", 0, &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], attributeStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { goto end; } if (attributeStringsAllocated != NULL) { @@ -1196,8 +1196,8 @@ TclFileLinkCmd( static const char *const linkTypes[] = { "-symbolic", "-hard", NULL }; - if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "switch", 0, - &linkAction) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], linkTypes, + sizeof(char *), "switch", 0, &linkAction) != TCL_OK) { return TCL_ERROR; } if (linkAction == 0) { diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5d4702b..847a97a 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -37,6 +37,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() @@ -1247,8 +1256,8 @@ Tcl_GlobObjCmd( dir = PATH_NONE; typePtr = NULL; for (i = 1; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "option", 0, &index) != TCL_OK) { string = Tcl_GetStringFromObj(objv[i], &length); if (string[0] == '-') { /* @@ -1270,7 +1279,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)) { @@ -1620,41 +1632,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); @@ -1705,7 +1682,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 f1d85bf..8e2c405 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -126,7 +126,7 @@ typedef struct CopyState { * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { +typedef struct { NextChannelHandler *nestedHandlerPtr; /* This variable holds the list of nested * ChannelHandlerEventProc invocations. */ @@ -512,11 +512,11 @@ TclFinalizeIOSubsystem(void) int active = 1; /* Flag == 1 while there's still work to do */ int doflushnb; - /* Fetch the pre-TIP#398 compatibility flag */ + /* Fetch the pre-TIP#398 compatibility flag */ { const char *s; Tcl_DString ds; - + s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); doflushnb = ((s != NULL) && strcmp(s, "0")); if (s != NULL) { @@ -568,9 +568,9 @@ TclFinalizeIOSubsystem(void) /* Set the channel back into blocking mode to ensure that we wait * for all data to flush out. */ - + (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, - "-blocking", "on"); + "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || @@ -7175,47 +7175,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. @@ -9017,8 +8976,8 @@ Tcl_FileEventObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0, - &modeIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[2], modeOptions, + sizeof(char *), "event name", 0, &modeIndex) != TCL_OK) { return TCL_ERROR; } mask = maskArray[modeIndex]; @@ -9122,18 +9081,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..8f561b0 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -15,7 +15,7 @@ * Callback structure for accept callback in a TCP server. */ -typedef struct AcceptCallback { +typedef struct { char *script; /* Script to invoke. */ Tcl_Interp *interp; /* Interpreter in which to run it. */ } AcceptCallback; @@ -25,7 +25,7 @@ typedef struct AcceptCallback { * It must be per-thread because of std channel limitations. */ -typedef struct ThreadSpecificData { +typedef struct { int initialized; /* Set to 1 when the module is initialized. */ Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */ } ThreadSpecificData; @@ -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 @@ -429,25 +416,11 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if TCL_MAJOR_VERSION < 9 - /* - * The code below provides backwards compatibility with an old - * form of the command that is no longer recommended or - * documented. See also [Bug #3151675]. Will be removed in Tcl 9, - * maybe even earlier. - */ - - if (strcmp(TclGetString(objv[i]), "nonewline") != 0) { -#endif Tcl_SetObjResult(interp, Tcl_ObjPrintf( "expected non-negative integer but got \"%s\"", TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if TCL_MAJOR_VERSION < 9 - } - newline = 1; -#endif } } @@ -1351,11 +1324,11 @@ AcceptCallbackProc( if (acceptCallbackPtr->interp != NULL) { char portBuf[TCL_INTEGER_SPACE]; - char *script = acceptCallbackPtr->script; + Tcl_Obj *script = Tcl_NewStringObj(acceptCallbackPtr->script, -1); Tcl_Interp *interp = acceptCallbackPtr->interp; int result; - Tcl_Preserve(script); + Tcl_IncrRefCount(script); Tcl_Preserve(interp); TclFormatInt(portBuf, port); @@ -1368,8 +1341,12 @@ AcceptCallbackProc( Tcl_RegisterChannel(NULL, chan); - result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan), - " ", address, " ", portBuf, NULL); + result = Tcl_ListObjAppendElement(interp, script, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + if (result == TCL_OK) { + Tcl_ListObjAppendElement(NULL, script, Tcl_NewStringObj(address, -1)); + Tcl_ListObjAppendElement(NULL, script, Tcl_NewStringObj(portBuf, -1)); + result = Tcl_EvalObjEx(interp, script, 0); + } if (result != TCL_OK) { Tcl_BackgroundException(interp, result); Tcl_UnregisterChannel(interp, chan); @@ -1383,7 +1360,7 @@ AcceptCallbackProc( Tcl_UnregisterChannel(NULL, chan); Tcl_Release(interp); - Tcl_Release(script); + Tcl_DecrRefCount(script); } else { /* * The interpreter has been deleted, so there is no useful way to use diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index cb0282a..4b61538 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -256,7 +256,7 @@ typedef enum { * sharing problems. */ -typedef struct ForwardParamBase { +typedef struct { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if @@ -331,7 +331,7 @@ typedef struct ForwardingResult ForwardingResult; * General event structure, with reference to operation specific data. */ -typedef struct ForwardingEvent { +typedef struct { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ @@ -368,7 +368,7 @@ struct ForwardingResult { * results. */ }; -typedef struct ThreadSpecificData { +typedef struct { /* * Table of all reflected channels owned by this thread. This is the * per-thread version of the per-interpreter map. @@ -774,7 +774,7 @@ TclChanCreateObjCmd( *---------------------------------------------------------------------- */ -typedef struct ReflectEvent { +typedef struct { Tcl_Event header; ReflectedChannel *rcPtr; int events; diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 1de635f..2ab634c 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = { * layers upon reading from the channel, plus the functions to manage such. */ -typedef struct _ResultBuffer_ { +typedef struct { unsigned char *buf; /* Reference to the buffer area. */ int allocated; /* Allocated size of the buffer area. */ int used; /* Number of bytes in the buffer, @@ -252,7 +252,7 @@ typedef enum { * sharing problems. */ -typedef struct ForwardParamBase { +typedef struct { int code; /* O: Ok/Fail of the cmd handler */ char *msgStr; /* O: Error message for handler failure */ int mustFree; /* O: True if msgStr is allocated, false if @@ -297,7 +297,7 @@ typedef struct ForwardingResult ForwardingResult; * General event structure, with reference to operation specific data. */ -typedef struct ForwardingEvent { +typedef struct { Tcl_Event event; /* Basic event data, has to be first item */ ForwardingResult *resultPtr; ForwardedOperation op; /* Forwarded driver operation */ @@ -328,7 +328,7 @@ struct ForwardingResult { * results. */ }; -typedef struct ThreadSpecificData { +typedef struct { /* * Table of all reflected transformations owned by this thread. */ @@ -615,8 +615,8 @@ TclChanPushObjCmd( methods = 0; while (listc > 0) { - if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, - "method", TCL_EXACT, &methIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, listv[listc-1], methodNames, + sizeof(char *), "method", TCL_EXACT, &methIndex) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned %s", Tcl_GetString(cmdObj), @@ -943,7 +943,7 @@ ReflectClose( Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); return errorCode; - } + } #endif /* TCL_THREADS */ errorCodeSet = 1; goto cleanup; @@ -957,7 +957,7 @@ ReflectClose( Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform); return errorCode; - } + } #endif /* TCL_THREADS */ errorCodeSet = 1; goto cleanup; diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 6259216..a8dd484 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -51,7 +51,7 @@ typedef struct FilesystemRecord { * this information each time the corresponding epoch counter changes. */ -typedef struct ThreadSpecificData { +typedef struct { int initialized; int cwdPathEpoch; int filesystemEpoch; @@ -240,7 +240,7 @@ static Tcl_ThreadDataKey fsDataKey; * code. */ -typedef struct FsDivertLoad { +typedef struct { Tcl_LoadHandle loadHandle; Tcl_FSUnloadFileProc *unloadProcPtr; Tcl_Obj *divertedFile; @@ -407,22 +407,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. */ @@ -2488,8 +2472,8 @@ TclFSFileAttrIndex( Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1); int result; - result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT, - indexPtr); + result = Tcl_GetIndexFromObjStruct(NULL, tmpObj, attrTable, + sizeof(char *), NULL, TCL_EXACT, indexPtr); TclDecrRefCount(tmpObj); if (listObj != NULL) { TclDecrRefCount(listObj); @@ -3376,7 +3360,7 @@ Tcl_LoadFile( return retVal; resolveSymbols: - /* + /* * At this point, *handlePtr is already set up to the handle for the * loaded library. We now try to resolve the symbols. */ @@ -3385,7 +3369,7 @@ Tcl_LoadFile( for (i=0 ; symbols[i] != NULL; i++) { procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]); if (procPtrs[i] == NULL) { - /* + /* * At least one symbol in the list was not found. Unload the * file, and report the problem back to the caller. * (Tcl_FindSymbol should already have left an appropriate @@ -3405,7 +3389,7 @@ Tcl_LoadFile( *---------------------------------------------------------------------- * * DivertFindSymbol -- - * + * * Find a symbol in a shared library loaded by copy-from-VFS. * *---------------------------------------------------------------------- diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ce8b9fb..b80d649 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -79,69 +79,6 @@ typedef struct { /* *---------------------------------------------------------------------- * - * Tcl_GetIndexFromObj -- - * - * This function looks up an object's value in a table of strings and - * returns the index of the matching string, if any. - * - * Results: - * If the value of objPtr is identical to or a unique abbreviation for - * one of the entries in tablePtr, then the return value is TCL_OK and the - * index of the matching entry is stored at *indexPtr. If there isn't a - * proper match, then TCL_ERROR is returned and an error message is left - * in interp's result (unless interp is NULL). The msg argument is used - * in the error message; for example, if msg has the value "option" then - * the error message will say something flag 'bad option "foo": must be - * ...' - * - * Side effects: - * The result of the lookup is cached as the internal rep of objPtr, so - * that repeated lookups can be done quickly. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_GetIndexFromObj -int -Tcl_GetIndexFromObj( - Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const char *const*tablePtr, /* Array of strings to compare against the - * value of objPtr; last entry must be NULL - * and there must not be duplicate entries. */ - const char *msg, /* Identifying word to use in error - * messages. */ - int flags, /* 0 or TCL_EXACT */ - int *indexPtr) /* Place to store resulting integer index. */ -{ - - /* - * See if there is a valid cached result from a previous lookup (doing the - * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in - * the common case where the result is cached). - */ - - if (objPtr->typePtr == &indexType) { - IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; - - /* - * Here's hoping we don't get hit by unfortunate packing constraints - * on odd platforms like a Cray PVP... - */ - - if (indexRep->tablePtr == (void *) tablePtr - && indexRep->offset == sizeof(char *)) { - *indexPtr = indexRep->index; - return TCL_OK; - } - } - return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *), - msg, flags, indexPtr); -} - -/* - *---------------------------------------------------------------------- - * * GetIndexFromObjList -- * * This procedure looks up an object's value in a table of strings and @@ -592,8 +529,8 @@ PrefixMatchObjCmd( } for (i = 1; i < (objc - 2); i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], matchOptions, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum matchOptions) index) { @@ -662,7 +599,7 @@ PrefixMatchObjCmd( } Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewStringObj("-code", 5)); - Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewIntObj(result)); + Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewLongObj(result)); return Tcl_SetReturnOptions(interp, errorPtr); } @@ -878,7 +815,8 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - int i, len, elemLen, flags; + int i, len, elemLen; + char flags; Interp *iPtr = (Interp *) interp; const char *elementStr; @@ -1464,8 +1402,8 @@ TclGetCompletionCodeFromObj( && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) { return TCL_OK; } - if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT, - codePtr) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, value, returnCodes, + sizeof(char *), NULL, TCL_EXACT, codePtr) == TCL_OK) { return TCL_OK; } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index f0e907f..244a7b2 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) @@ -455,29 +457,35 @@ declare 111 { Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } -declare 112 { - int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - Tcl_Obj *objPtr) -} -declare 113 { - Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, - ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) -} -declare 114 { - void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) -} -declare 115 { - int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int resetListFirst) -} -declare 116 { - Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} -declare 117 { - Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, - Tcl_Namespace *contextNsPtr, int flags) -} +# Removed in 9.0: +#declare 112 { +# int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 113 { +# Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name, +# ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc) +#} +# Removed in 9.0: +#declare 114 { +# void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr) +#} +# Removed in 9.0: +#declare 115 { +# int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int resetListFirst) +#} +# Removed in 9.0: +#declare 116 { +# Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} +# Removed in 9.0: +#declare 117 { +# Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) @@ -490,31 +498,37 @@ declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } -declare 121 { - int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern) -} -declare 122 { - Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) -} -declare 123 { - void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, - Tcl_Obj *objPtr) -} -declare 124 { - Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) -} -declare 125 { - Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) -} +# Removed in 9.0: +#declare 121 { +# int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern) +#} +# Removed in 9.0: +#declare 122 { +# Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 123 { +# void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command, +# Tcl_Obj *objPtr) +#} +# Removed in 9.0: +#declare 124 { +# Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp) +#} +# Removed in 9.0: +#declare 125 { +# Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp) +#} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } -declare 127 { - int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, - const char *pattern, int allowOverwrite) -} +# Removed in 9.0: +#declare 127 { +# int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int allowOverwrite) +#} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } @@ -533,9 +547,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 +566,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 +578,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, @@ -626,14 +641,14 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } -# REMOVED (except from stub table) - use public Tcl_SetStartupScript() -declare 158 { - void TclSetStartupScriptFileName(const char *filename) -} -# REMOVED (except from stub table) - use public Tcl_GetStartupScript() -declare 159 { - const char *TclGetStartupScriptFileName(void) -} +# REMOVED - use public Tcl_SetStartupScript() +#declare 158 { +# void TclSetStartupScriptFileName(const char *filename) +#} +# REMOVED - use public Tcl_GetStartupScript() +#declare 159 { +# const char *TclGetStartupScriptFileName(void) +#} #declare 160 { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, # Tcl_DString *dirPtr, char *pattern, char *tail, @@ -678,17 +693,17 @@ declare 166 { } # VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above) -# REMOVED (except from stub table) - use public Tcl_SetStartupScript() -declare 167 { - void TclSetStartupScriptPath(Tcl_Obj *pathPtr) -} -# REMOVED (except from stub table) - use public Tcl_GetStartupScript() -declare 168 { - Tcl_Obj *TclGetStartupScriptPath(void) -} +# REMOVED - use public Tcl_SetStartupScript() +#declare 167 { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +# REMOVED - use public Tcl_GetStartupScript() +#declare 168 { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { - int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n) + int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) } declare 170 { int TclCheckInterpTraces(Tcl_Interp *interp, const char *command, @@ -731,13 +746,13 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } -# TIP 338 made these public - now declared in tcl.h too -declare 178 { - void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) -} -declare 179 { - Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) -} +# TIP 338 made these public - now declared in tcl.h +#declare 178 { +# void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +#} +#declare 179 { +# Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr) +#} # REMOVED # Allocate lists without copying arrays @@ -749,14 +764,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 +956,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 +1035,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) @@ -1042,9 +1058,10 @@ declare 5 win { # declare 5 win { # HINSTANCE TclWinLoadLibrary(char *name) # } -declare 6 win { - unsigned short TclWinNToHS(unsigned short ns) -} +# Removed in 8.1: +#declare 6 win { +# unsigned short TclWinNToHS(unsigned short ns) +#} declare 7 win { int TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval, int optlen) @@ -1055,10 +1072,10 @@ declare 8 win { declare 9 win { int TclWinGetPlatformId(void) } -# new for 8.4.20+/8.5.12+ Cygwin only -declare 10 win { - Tcl_DirEntry *TclpReaddir(DIR *dir) -} +# Removed in Tcl 9.0 +#declare 10 win { +# Tcl_DirEntry *TclpReaddir(DIR *dir) +#} # Removed in 8.3.1 (for Win32s only) #declare 10 win { # int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr) @@ -1109,10 +1126,10 @@ declare 19 win { declare 20 win { void TclWinAddProcess(HANDLE hProcess, DWORD id) } -# new for 8.4.20+/8.5.12+ -declare 21 win { - char *TclpInetNtoa(struct in_addr addr) -} +# Removed in Tcl 9.0 +#declare 21 win { +# char *TclpInetNtoa(struct in_addr addr) +#} # removed permanently for 8.4 #declare 21 win { # void TclpAsyncMark(Tcl_AsyncHandler async) @@ -1194,20 +1211,19 @@ declare 9 unix { # Added in 8.4: -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) -} -declare 13 unix { - char *TclpInetNtoa(struct in_addr addr) -} +# Removed in Tcl 9.0 +#declare 10 unix { +# Tcl_DirEntry *TclpReaddir(DIR *dir) +#} +#declare 11 unix { +# struct tm *TclpLocaltime_unix(const time_t *clock) +#} +#declare 12 unix { +# struct tm *TclpGmtime_unix(const time_t *clock) +#} +#declare 13 unix { +# char *TclpInetNtoa(struct in_addr addr) +#} # Added in 8.5: diff --git a/generic/tclInt.h b/generic/tclInt.h index feea6dd..55a5965 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -146,13 +146,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 { @@ -1761,42 +1761,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. */ @@ -1809,8 +1800,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. @@ -1840,19 +1829,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. */ @@ -1874,7 +1850,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 @@ -1912,8 +1887,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. */ @@ -2514,16 +2487,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, @@ -2830,8 +2793,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; @@ -2845,7 +2806,7 @@ MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); MODULE_SCOPE int TclConvertElement(const char *src, int length, - char *dst, int flags); + char *dst, char flags); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); /* TIP #280 - Modified token based evulation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, @@ -2911,9 +2872,6 @@ MODULE_SCOPE int TclGetOpenModeEx(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); -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, @@ -3053,7 +3011,7 @@ MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, int reStrLen, Tcl_DString *dsPtr, int *flagsPtr); MODULE_SCOPE int TclScanElement(const char *string, int length, - int *flagPtr); + char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr, @@ -3136,9 +3094,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[]); @@ -3945,24 +3900,33 @@ typedef const char *TclDTraceStr; * Invalidate the string rep first so we can use the bytes value for our * pointer chain, and signal an obj deletion (as opposed to shimmering) with * 'length == -1'. - * Use empty 'if ; else' to handle use in unbraced outer if/else conditions. + * + * Use do/while0 idiom for optimum correctness without compiler warnings. + * http://c2.com/cgi/wiki?TrivialDoWhileLoop + * + * Decrement refCount AFTER checking it for 0 or 1 (<2), because + * we cannot assume anymore that refCount is a signed type; In + * Tcl8 it was but in Tcl9 it is subject to change. */ # define TclDecrRefCount(objPtr) \ - if (--(objPtr)->refCount > 0) ; else { \ - if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ - TCL_DTRACE_OBJ_FREE(objPtr); \ - if ((objPtr)->bytes \ - && ((objPtr)->bytes != tclEmptyStringRep)) { \ - ckfree((char *) (objPtr)->bytes); \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- < 2) { \ + if (!_objPtr->typePtr || !_objPtr->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(_objPtr); \ + if (_objPtr->bytes \ + && (_objPtr->bytes != tclEmptyStringRep)) { \ + ckfree((char *) _objPtr->bytes); \ + } \ + _objPtr->length = -1; \ + TclFreeObjStorage(_objPtr); \ + TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(_objPtr); \ } \ - (objPtr)->length = -1; \ - TclFreeObjStorage(objPtr); \ - TclIncrObjsFreed(); \ - } else { \ - TclFreeObj(objPtr); \ } \ - } + } while(0) #if defined(PURIFY) @@ -4391,9 +4355,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * core. They should only be called on unshared objects. The ANSI C * "prototypes" for these macros are: * - * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue); * MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue); - * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue); * MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d); *---------------------------------------------------------------- @@ -4407,9 +4369,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; (objPtr)->typePtr = &tclIntType; \ } while (0) -#define TclSetIntObj(objPtr, l) \ - TclSetLongObj(objPtr, l) - /* * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set * programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1. @@ -4417,9 +4376,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * value of strings like: "yes", "no", "true", "false", "on", "off". */ -#define TclSetBooleanObj(objPtr, b) \ - TclSetLongObj(objPtr, (b)!=0); - #ifndef TCL_WIDE_INT_IS_LONG #define TclSetWideIntObj(objPtr, w) \ do { \ @@ -4444,9 +4400,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; * types, avoiding the corresponding function calls in time critical parts of * the core. The ANSI C "prototypes" for these macros are: * - * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, int i); * MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l); - * MODULE_SCOPE void TclNewBooleanObj(Tcl_Obj *objPtr, int b); * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w); * MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d); * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len); @@ -4467,16 +4421,6 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) -#define TclNewIntObj(objPtr, l) \ - TclNewLongObj(objPtr, l) - -/* - * NOTE: There is to be no such thing as a "pure" boolean. - * See comment above TclSetBooleanObj macro above. - */ -#define TclNewBooleanObj(objPtr, b) \ - TclNewLongObj((objPtr), (b)!=0) - #define TclNewDoubleObj(objPtr, d) \ do { \ TclIncrObjsAllocated(); \ @@ -4499,15 +4443,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit; } while (0) #else /* TCL_MEM_DEBUG */ -#define TclNewIntObj(objPtr, i) \ - (objPtr) = Tcl_NewIntObj(i) - #define TclNewLongObj(objPtr, l) \ (objPtr) = Tcl_NewLongObj(l) -#define TclNewBooleanObj(objPtr, b) \ - (objPtr) = Tcl_NewBooleanObj(b) - #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 47c6afd..286f318 100644..100755 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -17,33 +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 -#undef Tcl_AppendExportList -#undef Tcl_Export -#undef Tcl_Import -#undef Tcl_ForgetImport -#undef Tcl_GetCurrentNamespace -#undef Tcl_GetGlobalNamespace -#undef Tcl_FindNamespace -#undef Tcl_FindCommand -#undef Tcl_GetCommandFromObj -#undef Tcl_GetCommandFullName -#undef Tcl_SetStartupScript -#undef Tcl_GetStartupScript - /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -64,166 +37,162 @@ extern "C" { /* 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 */ @@ -231,242 +200,206 @@ 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, - Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); -/* 113 */ -EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp, - const char *name, ClientData clientData, - Tcl_NamespaceDeleteProc *deleteProc); -/* 114 */ -EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr); -/* 115 */ -EXTERN 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, - Tcl_Namespace *contextNsPtr, int flags); -/* 117 */ -EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp, - const char *name, - Tcl_Namespace *contextNsPtr, int flags); +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ /* 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, - Tcl_Namespace *nsPtr, const char *pattern); -/* 122 */ -EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr); -/* 123 */ -EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, - Tcl_Command command, Tcl_Obj *objPtr); -/* 124 */ -EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp); -/* 125 */ -EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp); +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ /* 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, - const char *pattern, int allowOverwrite); +/* Slot 127 is reserved */ /* 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); -/* 159 */ -EXTERN const char * TclGetStartupScriptFileName(void); +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* 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); -/* 168 */ -EXTERN Tcl_Obj * TclGetStartupScriptPath(void); +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ /* 169 */ -EXTERN int TclpUtfNcmp2(const char *s1, const char *s2, - unsigned long n); +TCLAPI int TclpUtfNcmp2(const char *s1, const char *s2, + size_t 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, - const char *encodingName); -/* 179 */ -EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr); +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* 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 */ @@ -482,137 +415,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 { @@ -627,7 +559,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 */ @@ -661,7 +593,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 */ @@ -672,7 +604,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); @@ -696,7 +628,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); @@ -720,10 +652,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); @@ -731,36 +663,36 @@ typedef struct TclIntStubs { int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */ int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */ void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */ - int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */ - Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */ - void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */ - int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */ - Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */ - Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */ + void (*reserved112)(void); + void (*reserved113)(void); + void (*reserved114)(void); + void (*reserved115)(void); + void (*reserved116)(void); + void (*reserved117)(void); int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */ int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */ Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */ - int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */ - Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */ - void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */ - Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */ - Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */ + void (*reserved121)(void); + void (*reserved122)(void); + void (*reserved123)(void); + void (*reserved124)(void); + void (*reserved125)(void); void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */ - int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */ + void (*reserved127)(void); void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */ int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */ int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */ void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */ int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */ - 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 */ @@ -777,8 +709,8 @@ typedef struct TclIntStubs { void (*reserved155)(void); void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */ Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */ - void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */ - const char * (*tclGetStartupScriptFileName) (void); /* 159 */ + void (*reserved158)(void); + void (*reserved159)(void); void (*reserved160)(void); int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */ void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */ @@ -786,9 +718,9 @@ typedef struct TclIntStubs { void (*tclExpandCodeArray) (void *envPtr); /* 164 */ void (*tclpSetInitialEncodings) (void); /* 165 */ int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */ - void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */ - Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */ - int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */ + void (*reserved167)(void); + void (*reserved168)(void); + int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */ int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */ int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */ int (*tclInThreadExit) (void); /* 172 */ @@ -797,12 +729,12 @@ typedef struct TclIntStubs { int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */ void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */ void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */ - void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */ - Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */ + void (*reserved178)(void); + void (*reserved179)(void); 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); @@ -855,7 +787,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 */ @@ -896,8 +828,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 \ @@ -1004,8 +935,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 */ @@ -1044,8 +974,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 */ @@ -1057,38 +986,26 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */ #define Tcl_AddInterpResolvers \ (tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */ -#define Tcl_AppendExportList \ - (tclIntStubsPtr->tcl_AppendExportList) /* 112 */ -#define Tcl_CreateNamespace \ - (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */ -#define Tcl_DeleteNamespace \ - (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */ -#define Tcl_Export \ - (tclIntStubsPtr->tcl_Export) /* 115 */ -#define Tcl_FindCommand \ - (tclIntStubsPtr->tcl_FindCommand) /* 116 */ -#define Tcl_FindNamespace \ - (tclIntStubsPtr->tcl_FindNamespace) /* 117 */ +/* Slot 112 is reserved */ +/* Slot 113 is reserved */ +/* Slot 114 is reserved */ +/* Slot 115 is reserved */ +/* Slot 116 is reserved */ +/* Slot 117 is reserved */ #define Tcl_GetInterpResolvers \ (tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */ #define Tcl_GetNamespaceResolvers \ (tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */ #define Tcl_FindNamespaceVar \ (tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */ -#define Tcl_ForgetImport \ - (tclIntStubsPtr->tcl_ForgetImport) /* 121 */ -#define Tcl_GetCommandFromObj \ - (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */ -#define Tcl_GetCommandFullName \ - (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */ -#define Tcl_GetCurrentNamespace \ - (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */ -#define Tcl_GetGlobalNamespace \ - (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */ +/* Slot 121 is reserved */ +/* Slot 122 is reserved */ +/* Slot 123 is reserved */ +/* Slot 124 is reserved */ +/* Slot 125 is reserved */ #define Tcl_GetVariableFullName \ (tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */ -#define Tcl_Import \ - (tclIntStubsPtr->tcl_Import) /* 127 */ +/* Slot 127 is reserved */ #define Tcl_PopCallFrame \ (tclIntStubsPtr->tcl_PopCallFrame) /* 128 */ #define Tcl_PushCallFrame \ @@ -1099,8 +1016,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 */ @@ -1141,10 +1057,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclRegError) /* 156 */ #define TclVarTraceExists \ (tclIntStubsPtr->tclVarTraceExists) /* 157 */ -#define TclSetStartupScriptFileName \ - (tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */ -#define TclGetStartupScriptFileName \ - (tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */ +/* Slot 158 is reserved */ +/* Slot 159 is reserved */ /* Slot 160 is reserved */ #define TclChannelTransform \ (tclIntStubsPtr->tclChannelTransform) /* 161 */ @@ -1158,10 +1072,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */ #define TclListObjSetElement \ (tclIntStubsPtr->tclListObjSetElement) /* 166 */ -#define TclSetStartupScriptPath \ - (tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */ -#define TclGetStartupScriptPath \ - (tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */ +/* Slot 167 is reserved */ +/* Slot 168 is reserved */ #define TclpUtfNcmp2 \ (tclIntStubsPtr->tclpUtfNcmp2) /* 169 */ #define TclCheckInterpTraces \ @@ -1179,16 +1091,12 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclCleanupVar) /* 176 */ #define TclVarErrMsg \ (tclIntStubsPtr->tclVarErrMsg) /* 177 */ -#define Tcl_SetStartupScript \ - (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */ -#define Tcl_GetStartupScript \ - (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */ +/* Slot 178 is reserved */ +/* Slot 179 is reserved */ /* 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 */ @@ -1269,8 +1177,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 \ @@ -1304,61 +1211,4 @@ extern const TclIntStubs *tclIntStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - -#undef TclGetStartupScriptFileName -#undef TclSetStartupScriptFileName -#undef TclGetStartupScriptPath -#undef TclSetStartupScriptPath -#undef TclBackgroundException - -#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED) -# undef Tcl_SetStartupScript -# define Tcl_SetStartupScript \ - (tclStubsPtr->tcl_SetStartupScript) /* 622 */ -# undef Tcl_GetStartupScript -# define Tcl_GetStartupScript \ - (tclStubsPtr->tcl_GetStartupScript) /* 623 */ -# undef Tcl_CreateNamespace -# define Tcl_CreateNamespace \ - (tclStubsPtr->tcl_CreateNamespace) /* 506 */ -# undef Tcl_DeleteNamespace -# define Tcl_DeleteNamespace \ - (tclStubsPtr->tcl_DeleteNamespace) /* 507 */ -# undef Tcl_AppendExportList -# define Tcl_AppendExportList \ - (tclStubsPtr->tcl_AppendExportList) /* 508 */ -# undef Tcl_Export -# define Tcl_Export \ - (tclStubsPtr->tcl_Export) /* 509 */ -# undef Tcl_Import -# define Tcl_Import \ - (tclStubsPtr->tcl_Import) /* 510 */ -# undef Tcl_ForgetImport -# define Tcl_ForgetImport \ - (tclStubsPtr->tcl_ForgetImport) /* 511 */ -# undef Tcl_GetCurrentNamespace -# define Tcl_GetCurrentNamespace \ - (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */ -# undef Tcl_GetGlobalNamespace -# define Tcl_GetGlobalNamespace \ - (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */ -# undef Tcl_FindNamespace -# define Tcl_FindNamespace \ - (tclStubsPtr->tcl_FindNamespace) /* 514 */ -# undef Tcl_FindCommand -# define Tcl_FindCommand \ - (tclStubsPtr->tcl_FindCommand) /* 515 */ -# undef Tcl_GetCommandFromObj -# define Tcl_GetCommandFromObj \ - (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */ -# undef Tcl_GetCommandFullName -# define Tcl_GetCommandFullName \ - (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ -#endif - -#undef TclCopyChannelOld -#undef TclSockMinimumBuffersOld - #endif /* _TCLINTDECLS */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 72719fe..7981da1 100644..100755 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -13,22 +13,6 @@ #ifndef _TCLINTPLATDECLS #define _TCLINTPLATDECLS -#ifdef __WIN32__ -# define Tcl_DirEntry void -# define DIR void -#endif - -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#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 @@ -47,40 +31,36 @@ extern "C" { #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); -/* 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); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI TclFile TclpCreateTempFile(const char *contents); +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 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 */ @@ -98,144 +78,136 @@ 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); -/* 6 */ -EXTERN unsigned short TclWinNToHS(unsigned short ns); +TCLAPI int TclUnixWaitForFile(int fd, int mask, int timeout); +/* Slot 6 is reserved */ /* 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); -/* 10 */ -EXTERN Tcl_DirEntry * TclpReaddir(DIR *dir); +TCLAPI int TclWinGetPlatformId(void); +/* Slot 10 is reserved */ /* 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); -/* 21 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI void TclWinAddProcess(HANDLE hProcess, DWORD id); +/* Slot 21 is reserved */ /* 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); -/* 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); -/* 13 */ -EXTERN char * TclpInetNtoa(struct in_addr addr); +TCLAPI TclFile TclpCreateTempFile(const char *contents); +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ /* 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 */ @@ -247,9 +219,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 */ @@ -269,10 +241,10 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved10)(void); + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ void (*reserved15)(void); void (*reserved16)(void); @@ -293,16 +265,16 @@ 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 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */ - unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */ + void (*reserved6)(void); int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */ int (*tclpGetPid) (Tcl_Pid pid); /* 8 */ int (*tclWinGetPlatformId) (void); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ + void (*reserved10)(void); void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */ int (*tclpCloseFile) (TclFile file); /* 12 */ Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */ @@ -313,7 +285,7 @@ typedef struct TclIntPlatStubs { TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */ TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */ void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */ + void (*reserved21)(void); TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */ void (*reserved23)(void); char * (*tclWinNoBackslash) (char *path); /* 24 */ @@ -335,10 +307,10 @@ typedef struct TclIntPlatStubs { TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */ int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */ TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */ - Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */ - struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */ - struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */ - char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */ + void (*reserved10)(void); + void (*reserved11)(void); + void (*reserved12)(void); + void (*reserved13)(void); int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */ int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */ int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */ @@ -391,14 +363,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ /* Slot 15 is reserved */ @@ -423,8 +391,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 \ @@ -433,16 +400,14 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */ #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */ -#define TclWinNToHS \ - (tclIntPlatStubsPtr->tclWinNToHS) /* 6 */ +/* Slot 6 is reserved */ #define TclWinSetSockOpt \ (tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */ #define TclpGetPid \ (tclIntPlatStubsPtr->tclpGetPid) /* 8 */ #define TclWinGetPlatformId \ (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ +/* Slot 10 is reserved */ #define TclGetAndDetachPids \ (tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */ #define TclpCloseFile \ @@ -463,8 +428,7 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclpOpenFile) /* 19 */ #define TclWinAddProcess \ (tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */ +/* Slot 21 is reserved */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ /* Slot 23 is reserved */ @@ -502,14 +466,10 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #define TclpCreateTempFile \ (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ -#define TclpReaddir \ - (tclIntPlatStubsPtr->tclpReaddir) /* 10 */ -#define TclpLocaltime_unix \ - (tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */ -#define TclpGmtime_unix \ - (tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */ -#define TclpInetNtoa \ - (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ +/* Slot 10 is reserved */ +/* Slot 11 is reserved */ +/* Slot 12 is reserved */ +/* Slot 13 is reserved */ #define TclUnixCopyFile \ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */ #define TclMacOSXGetFileAttribute \ @@ -541,19 +501,7 @@ 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 -#undef TclpInetNtoa -#define TclpInetNtoa inet_ntoa - -#if defined(__WIN32__) || defined(__CYGWIN__) -# undef TclWinNToHS -# define TclWinNToHS ntohs -#else +#if !defined(__WIN32__) && !defined(__CYGWIN__) # undef TclpGetPid # define TclpGetPid(pid) ((unsigned long) (pid)) #endif diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 0da5d47..513310e 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -25,14 +25,14 @@ static const char *tclPreInitScript = NULL; struct Target; /* - * struct Alias: + * Alias: * * Stores information about an alias. Is stored in the slave interpreter and * used by the source command to find the target command in the master when * the source command is invoked. */ -typedef struct Alias { +typedef struct { Tcl_Obj *token; /* Token for the alias command in the slave * interp. This used to be the command name in * the slave when the alias was first @@ -73,7 +73,7 @@ typedef struct Alias { * slave interpreter, e.g. what aliases are defined in it. */ -typedef struct Slave { +typedef struct { Tcl_Interp *masterInterp; /* Master interpreter for this slave. */ Tcl_HashEntry *slaveEntryPtr; /* Hash entry in masters slave table for this @@ -84,7 +84,7 @@ typedef struct Slave { Tcl_Interp *slaveInterp; /* The slave interpreter. */ Tcl_Command interpCmd; /* Interpreter object command. */ Tcl_HashTable aliasTable; /* Table which maps from names of commands in - * slave interpreter to struct Alias defined + * slave interpreter to Alias defined * below. */ } Slave; @@ -127,7 +127,7 @@ typedef struct Target { * only load safe extensions. */ -typedef struct Master { +typedef struct { Tcl_HashTable slaveTable; /* Hash table for slave interpreters. Maps * from command names to Slave records. */ Target *targetsPtr; /* The head of a doubly-linked list of all the @@ -144,7 +144,7 @@ typedef struct Master { * on a per-interp basis. */ -typedef struct InterpInfo { +typedef struct { Master master; /* Keeps track of all interps for which this * interp is the Master. */ Slave slave; /* Information necessary for this interp to @@ -158,7 +158,7 @@ typedef struct InterpInfo { * likely to work properly on 64-bit architectures. */ -typedef struct ScriptLimitCallback { +typedef struct { Tcl_Interp *interp; /* The interpreter in which to execute the * callback. */ Tcl_Obj *scriptObj; /* The script to execute to perform the @@ -171,7 +171,7 @@ typedef struct ScriptLimitCallback { * table. */ } ScriptLimitCallback; -typedef struct ScriptLimitCallbackKey { +typedef struct { Tcl_Interp *interp; /* The interpreter that the limit callback was * attached to. This is not the interpreter * that the callback runs in! */ @@ -336,7 +336,7 @@ Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { if (tclPreInitScript != NULL) { - if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { + if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) { return TCL_ERROR; } } @@ -382,7 +382,7 @@ Tcl_Init( * alternate tclInit command before calling Tcl_Init(). */ - return Tcl_Eval(interp, + return Tcl_EvalEx(interp, "if {[namespace which -command tclInit] eq \"\"} {\n" " proc tclInit {} {\n" " global tcl_libPath tcl_library env tclDefaultLibrary\n" @@ -444,7 +444,7 @@ Tcl_Init( " error $msg\n" " }\n" "}\n" -"tclInit"); +"tclInit", -1, 0); } /* @@ -3220,8 +3220,8 @@ Tcl_MakeSafe( * Assume these functions all work. [Bug 2895741] */ - (void) Tcl_Eval(interp, - "namespace eval ::tcl {namespace eval mathfunc {}}"); + (void) Tcl_EvalEx(interp, + "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master, "::tcl::mathfunc::min", 0, NULL); (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master, diff --git a/generic/tclLink.c b/generic/tclLink.c index 2735256..1d1ed21 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -21,7 +21,7 @@ * variable. */ -typedef struct Link { +typedef struct { Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ Tcl_Obj *varName; /* Name of variable (must be global). This is * needed during trace callbacks, since the diff --git a/generic/tclListObj.c b/generic/tclListObj.c index bd2dbc4..f5123e8 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -969,11 +969,7 @@ Tcl_ListObjReplace( if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { /* See bug 3598580 */ -#if TCL_MAJOR_VERSION > 8 Tcl_DecrRefCount(objv[i]); -#else - objv[i]->refCount--; -#endif } return TCL_ERROR; } @@ -1925,8 +1921,8 @@ static void UpdateStringOfList( Tcl_Obj *listPtr) /* List object with string rep to update. */ { -# define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr = NULL; +# define LOCAL_SIZE 64 + char localFlags[LOCAL_SIZE], *flagPtr = NULL; List *listRepPtr = ListRepPtr(listPtr); int numElems = listRepPtr->elemCount; int i, length, bytesNeeded = 0; @@ -1963,7 +1959,7 @@ UpdateStringOfList( * We know numElems <= LIST_MAX, so this is safe. */ - flagPtr = ckalloc(numElems * sizeof(int)); + flagPtr = ckalloc(numElems); } elemPtrs = &listRepPtr->elements; for (i = 0; i < numElems; i++) { 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 faea75a..875ccc3 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -109,7 +109,7 @@ typedef enum { PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; -typedef struct InteractiveState { +typedef struct { Tcl_Channel input; /* The standard input channel from which lines * are read. */ int tty; /* Non-zero means standard input is a @@ -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); @@ -280,7 +284,7 @@ Tcl_SourceRCFile( /*---------------------------------------------------------------------- * - * Tcl_Main, Tcl_MainEx -- + * Tcl_MainEx -- * * Main program for tclsh and most other Tcl-based applications. * @@ -361,7 +365,7 @@ Tcl_MainEx( argc--; argv++; - Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY); + Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewLongObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); while (argc--) { @@ -375,7 +379,7 @@ Tcl_MainEx( is.tty = isatty(0); Tcl_SetVar2Ex(interp, "tcl_interactive", NULL, - Tcl_NewIntObj(!path && is.tty), TCL_GLOBAL_ONLY); + Tcl_NewLongObj(!path && is.tty), TCL_GLOBAL_ONLY); /* * Invoke application-specific initialization. @@ -631,21 +635,6 @@ Tcl_MainEx( Tcl_Exit(exitCode); } - -#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE) -#undef Tcl_Main -extern DLLEXPORT void -Tcl_Main( - int argc, /* Number of arguments. */ - char **argv, /* Array of argument strings. */ - Tcl_AppInitProc *appInitProc) - /* Application-specific initialization - * function to call after most initialization - * but before starting to execute commands. */ -{ - Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp()); -} -#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */ #ifndef TCL_ASCII_MAIN diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index cd44455..c5c7dc8 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -31,7 +31,7 @@ * limited to a single interpreter. */ -typedef struct ThreadSpecificData { +typedef struct { long numNsCreated; /* Count of the number of namespaces created * within the thread. This value is used as a * unique id for each namespace. Cannot be @@ -52,7 +52,7 @@ static Tcl_ThreadDataKey dataKey; * with some information that is used to check the cached pointer's validity. */ -typedef struct ResolvedNsName { +typedef struct { Namespace *nsPtr; /* A cached pointer to the Namespace that the * name resolved to. */ Namespace *refNsPtr; /* Points to the namespace context in which @@ -343,7 +343,7 @@ Tcl_PushCallFrame( framePtr->clientData = NULL; framePtr->localCachePtr = NULL; framePtr->tailcallPtr = NULL; - + /* * Push the new call frame onto the interpreter's stack of procedure call * frames making it the current frame. @@ -3056,7 +3056,7 @@ NamespaceCodeCmd( */ arg = TclGetStringFromObj(objv[1], &length); - if (*arg==':' && length > 20 + if (*arg==':' && length > 20 && strncmp(arg, "::namespace inscope ", 20) == 0) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; @@ -3418,7 +3418,7 @@ NamespaceExistsCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj( + Tcl_SetObjResult(interp, Tcl_NewLongObj( GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK)); return TCL_OK; } @@ -4581,8 +4581,8 @@ NamespaceWhichCmd( * Look for a flag controlling the lookup. */ - if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, - &lookupType) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], opts, + sizeof(char *), "option", 0, &lookupType) != TCL_OK) { /* * Preserve old style of error message! */ @@ -4929,7 +4929,7 @@ TclLogCommandInfo( if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; - + newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); @@ -4961,7 +4961,7 @@ TclLogCommandInfo( Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(command, length)); } - } + } if (!iPtr->framePtr->objc) { /* @@ -4973,7 +4973,7 @@ TclLogCommandInfo( */ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral); - Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj( + Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewLongObj( iPtr->framePtr->level - iPtr->varFramePtr->level)); } else if (iPtr->framePtr != iPtr->rootFramePtr) { /* @@ -5014,7 +5014,7 @@ TclErrorStackResetIf( if (Tcl_IsShared(iPtr->errorStack)) { Tcl_Obj *newObj; - + newObj = Tcl_DuplicateObj(iPtr->errorStack); Tcl_DecrRefCount(iPtr->errorStack); Tcl_IncrRefCount(newObj); @@ -5034,7 +5034,7 @@ TclErrorStackResetIf( Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral); Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(msg, length)); - } + } } /* diff --git a/generic/tclOO.c b/generic/tclOO.c index 529640f..326f1ae 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -267,7 +267,7 @@ TclOOInit( * to be fully provided. */ - if (Tcl_Eval(interp, initScript) != TCL_OK) { + if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) { return TCL_ERROR; } @@ -458,7 +458,7 @@ InitFoundation( if (TclOODefineSlots(fPtr) != TCL_OK) { return TCL_ERROR; } - return Tcl_Eval(interp, slotScript); + return Tcl_EvalEx(interp, slotScript, -1, 0); } /* diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 5d6f2c2..8f0030c 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -17,7 +17,8 @@ library tclOO # interface tclOO -hooks tclOOInt +hooks tclOOPrivate +scspec TCLAPI declare 0 { Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, diff --git a/generic/tclOO.h b/generic/tclOO.h index a6e8a22..b8aa974 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -37,13 +37,8 @@ extern "C" { #endif -extern const char *TclOOInitializeStubs( - Tcl_Interp *, const char *version); -#define Tcl_OOInitStubs(interp) \ - TclOOInitializeStubs((interp), TCLOO_VERSION) -#ifndef USE_TCL_STUBS -# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) -#endif +#define Tcl_OOInitStubs(interp) (TCLOO_PATCHLEVEL) +#define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) /* * These are opaque types. diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 853e2ec..39b7878 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -982,8 +982,8 @@ TclOOSelfObjCmd( return TCL_ERROR; } else if (objc == 1) { index = SELF_OBJECT; - } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0, - &index) != TCL_OK) { + } else if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds, + sizeof(char *), "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1152,7 +1152,7 @@ TclOOSelfObjCmd( } case SELF_CALL: result[0] = TclOORenderCallChain(interp, contextPtr->callPtr); - result[1] = Tcl_NewIntObj(contextPtr->index); + result[1] = Tcl_NewLongObj(contextPtr->index); Tcl_SetObjResult(interp, Tcl_NewListObj(2, result)); return TCL_OK; } diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index d3b9e59..1d71359 100644..100755 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -5,19 +5,14 @@ #ifndef _TCLOODECLS #define _TCLOODECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# undef USE_TCLOO_STUBS -# define USE_TCLOO_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif +#ifdef USE_TCL_STUBS +# undef USE_TCLOO_STUBS +# define USE_TCLOO_STUBS #endif +#define tclOOPrivateStubs tclOOIntStubs +#define TclOOPrivateStubs TclOOIntStubs + /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus @@ -29,96 +24,96 @@ extern "C" { */ /* 0 */ -EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, +TCLAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 1 */ -EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); +TCLAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); /* 2 */ -EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); +TCLAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); /* 3 */ -EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); +TCLAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); /* 4 */ -EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, +TCLAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 5 */ -EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); +TCLAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); /* 6 */ -EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); +TCLAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); /* 7 */ -EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); +TCLAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); /* 8 */ -EXTERN int Tcl_MethodIsPublic(Tcl_Method method); +TCLAPI int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ -EXTERN int Tcl_MethodIsType(Tcl_Method method, +TCLAPI int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 10 */ -EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method); +TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ -EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, +TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ -EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, +TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 13 */ -EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, +TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 14 */ -EXTERN int Tcl_ObjectDeleted(Tcl_Object object); +TCLAPI int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ -EXTERN int Tcl_ObjectContextIsFiltering( +TCLAPI int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context); /* 16 */ -EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); +TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ -EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); +TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ -EXTERN int Tcl_ObjectContextSkippedArgs( +TCLAPI int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +TCLAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ -EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz, +TCLAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 21 */ -EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +TCLAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ -EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object, +TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 23 */ -EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, +TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 24 */ -EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( +TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); /* 25 */ -EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, +TCLAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 26 */ -EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp, +TCLAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ -EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp, +TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 28 */ -EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, +TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object); typedef struct { - const struct TclOOIntStubs *tclOOIntStubs; + const struct TclOOPrivateStubs *tclOOPrivateStubs; } TclOOStubHooks; typedef struct TclOOStubs { @@ -231,6 +226,4 @@ extern const TclOOStubs *tclOOStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOODECLS */ diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 3217f98..cbf49d3 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -197,11 +197,11 @@ InfoObjectClassCmd( FOREACH(mixinPtr, oPtr->mixins) { if (TclOOIsReachable(o2clsPtr, mixinPtr)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); return TCL_OK; } } - Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_SetObjResult(interp, Tcl_NewLongObj( TclOOIsReachable(o2clsPtr, oPtr->selfCls))); return TCL_OK; } @@ -418,7 +418,7 @@ InfoObjectIsACmd( if (!ok) { Tcl_ResetResult(interp); } - Tcl_SetObjResult(interp, Tcl_NewIntObj(ok ? 1 : 0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(ok!=0)); return TCL_OK; } oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]); @@ -432,7 +432,7 @@ InfoObjectIsACmd( Tcl_WrongNumArgs(interp, 2, objv, "objName"); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->classPtr ? 1 : 0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(oPtr->classPtr!=NULL)); return TCL_OK; case IsMetaclass: if (objc != 3) { @@ -440,12 +440,12 @@ InfoObjectIsACmd( return TCL_ERROR; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } else { Class *classCls = TclOOGetFoundation(interp)->classCls; - Tcl_SetObjResult(interp, Tcl_NewIntObj( - TclOOIsReachable(classCls, oPtr->classPtr) ? 1 : 0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj( + TclOOIsReachable(classCls, oPtr->classPtr)!=0)); } return TCL_OK; case IsMixin: @@ -467,12 +467,12 @@ InfoObjectIsACmd( FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr == o2Ptr->classPtr) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); return TCL_OK; } } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); return TCL_OK; case IsType: if (objc != 4) { @@ -490,9 +490,9 @@ InfoObjectIsACmd( return TCL_ERROR; } if (TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls)) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } return TCL_OK; case IsObject: diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 4f70e5b..74a8d81 100644..100755 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -5,17 +5,6 @@ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS -#undef TCL_STORAGE_CLASS -#ifdef BUILD_tcl -# define TCL_STORAGE_CLASS DLLEXPORT -#else -# ifdef USE_TCL_STUBS -# define TCL_STORAGE_CLASS -# else -# define TCL_STORAGE_CLASS DLLIMPORT -# endif -#endif - /* !BEGIN!: Do not edit below this line. */ #ifdef __cplusplus @@ -27,46 +16,46 @@ extern "C" { */ /* 0 */ -EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); +TCLAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); /* 1 */ -EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ -EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 3 */ -EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, +TCLAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ -EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, +TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ -EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, +TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ -EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr); +TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); /* 7 */ -EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp, +TCLAPI Method * TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ -EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, +TCLAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 9 */ -EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -75,7 +64,7 @@ EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ -EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, +TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -84,22 +73,22 @@ EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ -EXTERN int TclOOInvokeObject(Tcl_Interp *interp, +TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 12 */ -EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters, +TCLAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ -EXTERN void TclOOClassSetFilters(Tcl_Interp *interp, +TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 14 */ -EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins, +TCLAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins, Class *const *mixins); /* 15 */ -EXTERN void TclOOClassSetMixins(Tcl_Interp *interp, +TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); @@ -174,6 +163,4 @@ extern const TclOOIntStubs *tclOOIntStubsPtr; /* !END!: Do not edit above this line. */ -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOOINTDECLS */ diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c index 900ab22..7be341a 100644..100755 --- a/generic/tclOOStubInit.c +++ b/generic/tclOOStubInit.c @@ -9,6 +9,7 @@ #include "tclOOInt.h" MODULE_SCOPE const TclOOStubs tclOOStubs; +MODULE_SCOPE const TclOOIntStubs tclOOIntStubs; #ifdef __GNUC__ #pragma GCC dependency "tclOO.decls" @@ -16,7 +17,7 @@ MODULE_SCOPE const TclOOStubs tclOOStubs; /* !BEGIN!: Do not edit below this line. */ -static const TclOOIntStubs tclOOIntStubs = { +const TclOOIntStubs tclOOIntStubs = { TCL_STUB_MAGIC, 0, TclOOGetDefineCmdContext, /* 0 */ @@ -38,7 +39,7 @@ static const TclOOIntStubs tclOOIntStubs = { }; static const TclOOStubHooks tclOOStubHooks = { - &tclOOIntStubs + &tclOOPrivateStubs }; const TclOOStubs tclOOStubs = { diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c deleted file mode 100644 index a9fa212..0000000 --- a/generic/tclOOStubLib.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17 - */ - -#include "tclOOInt.h" - -MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; -MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; - -const TclOOStubs *tclOOStubsPtr = NULL; -const TclOOIntStubs *tclOOIntStubsPtr = NULL; - -/* - *---------------------------------------------------------------------- - * - * TclOOInitializeStubs -- - * Load the tclOO package, initialize stub table pointer. Do not call - * this function directly, use Tcl_OOInitStubs() macro instead. - * - * Results: - * The actual version of the package that satisfies the request, or NULL - * to indicate that an error occurred. - * - * Side effects: - * Sets the stub table pointers. - * - *---------------------------------------------------------------------- - */ - -#undef TclOOInitializeStubs - -MODULE_SCOPE const char * -TclOOInitializeStubs( - Tcl_Interp *interp, - const char *version) -{ - int exact = 0; - const char *packageName = "TclOO"; - const char *errMsg = NULL; - TclOOStubs *stubsPtr = NULL; - const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp, - packageName, version, exact, &stubsPtr); - - if (actualVersion == NULL) { - return NULL; - } - if (stubsPtr == NULL) { - errMsg = "missing stub table pointer"; - } else { - tclOOStubsPtr = stubsPtr; - if (stubsPtr->hooks) { - tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; - } else { - tclOOIntStubsPtr = NULL; - } - return actualVersion; - } - tclStubsPtr->tcl_ResetResult(interp); - tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName, - " (requested version ", version, ", actual version ", - actualVersion, "): ", errMsg, NULL); - return NULL; -} - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ diff --git a/generic/tclObj.c b/generic/tclObj.c index 930e1fd..00e598e 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -58,7 +58,7 @@ char *tclEmptyStringRep = &tclEmptyString; * for sanity checking purposes. */ -typedef struct ObjData { +typedef struct { Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */ const char *file; /* The name of the source file calling this * function; used for debugging. */ @@ -1731,7 +1731,7 @@ Tcl_NewBooleanObj( { register Tcl_Obj *objPtr; - TclNewBooleanObj(objPtr, boolValue); + TclNewLongObj(objPtr, boolValue!=0); return objPtr; } #endif /* TCL_MEM_DEBUG */ @@ -1825,7 +1825,7 @@ Tcl_SetBooleanObj( Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj"); } - TclSetBooleanObj(objPtr, boolValue); + TclSetLongObj(objPtr, boolValue!=0); } /* @@ -2393,7 +2393,7 @@ Tcl_NewIntObj( { register Tcl_Obj *objPtr; - TclNewIntObj(objPtr, intValue); + TclNewLongObj(objPtr, intValue); return objPtr; } #endif /* if TCL_MEM_DEBUG */ @@ -2426,7 +2426,7 @@ Tcl_SetIntObj( Tcl_Panic("%s called with shared object", "Tcl_SetIntObj"); } - TclSetIntObj(objPtr, intValue); + TclSetLongObj(objPtr, intValue); } /* @@ -2572,8 +2572,8 @@ UpdateStringOfInt( *---------------------------------------------------------------------- */ -#ifdef TCL_MEM_DEBUG #undef Tcl_NewLongObj +#ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_NewLongObj( @@ -2683,6 +2683,7 @@ Tcl_DbNewLongObj( *---------------------------------------------------------------------- */ +#undef Tcl_SetLongObj void Tcl_SetLongObj( register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ @@ -3771,7 +3772,7 @@ Tcl_DbDecrRefCount( * If the Tcl_Obj is going to be deleted, remove the entry. */ - if ((objPtr->refCount - 1) <= 0) { + if (objPtr->refCount < 2) { ObjData *objData = Tcl_GetHashValue(hPtr); if (objData != NULL) { @@ -3784,7 +3785,7 @@ Tcl_DbDecrRefCount( # endif /* TCL_THREADS */ #endif /* TCL_MEM_DEBUG */ - if (--(objPtr)->refCount <= 0) { + if ((objPtr)->refCount-- < 2) { TclFreeObj(objPtr); } } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index b7f3dcf..ea5c1b8 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -71,7 +71,7 @@ static const Tcl_ObjType tclFsPathType = { * */ -typedef struct FsPath { +typedef struct { Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this * is NULL, then this is a pure normalized, * absolute path object, in which the parent diff --git a/generic/tclPkg.c b/generic/tclPkg.c index df90cea..ec5d0e6 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -39,7 +39,7 @@ typedef struct PkgAvail { * "Tk" (no version number). */ -typedef struct Package { +typedef struct { char *version; /* Version that has been supplied in this * interpreter via "package provide" * (malloc'ed). NULL means the package doesn't @@ -88,7 +88,7 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, /* *---------------------------------------------------------------------- * - * Tcl_PkgProvide / Tcl_PkgProvideEx -- + * Tcl_PkgProvideEx -- * * This function is invoked to declare that a particular version of a * particular package is now present in an interpreter. There must not be @@ -106,17 +106,6 @@ static const char * PkgRequireCore(Tcl_Interp *interp, const char *name, *---------------------------------------------------------------------- */ -#undef Tcl_PkgProvide -int -Tcl_PkgProvide( - Tcl_Interp *interp, /* Interpreter in which package is now - * available. */ - const char *name, /* Name of package. */ - const char *version) /* Version string for package. */ -{ - return Tcl_PkgProvideEx(interp, name, version, NULL); -} - int Tcl_PkgProvideEx( Tcl_Interp *interp, /* Interpreter in which package is now @@ -165,7 +154,7 @@ Tcl_PkgProvideEx( /* *---------------------------------------------------------------------- * - * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc -- + * Tcl_PkgRequireEx / Tcl_PkgRequireProc -- * * This function is called by code that depends on a particular version * of a particular package. If the package is not already provided in the @@ -189,21 +178,6 @@ Tcl_PkgProvideEx( *---------------------------------------------------------------------- */ -#undef Tcl_PkgRequire -const char * -Tcl_PkgRequire( - Tcl_Interp *interp, /* Interpreter in which package is now - * available. */ - const char *name, /* Name of desired package. */ - const char *version, /* Version string for desired version; NULL - * means use the latest version available. */ - int exact) /* Non-zero means that only the particular - * version given is acceptable. Zero means use - * the latest compatible version. */ -{ - return Tcl_PkgRequireEx(interp, name, version, exact, NULL); -} - const char * Tcl_PkgRequireEx( Tcl_Interp *interp, /* Interpreter in which package is now @@ -654,7 +628,7 @@ PkgRequireCore( /* *---------------------------------------------------------------------- * - * Tcl_PkgPresent / Tcl_PkgPresentEx -- + * Tcl_PkgPresentEx -- * * Checks to see whether the specified package is present. If it is not * then no additional action is taken. @@ -672,21 +646,6 @@ PkgRequireCore( *---------------------------------------------------------------------- */ -#undef Tcl_PkgPresent -const char * -Tcl_PkgPresent( - Tcl_Interp *interp, /* Interpreter in which package is now - * available. */ - const char *name, /* Name of desired package. */ - const char *version, /* Version string for desired version; NULL - * means use the latest version available. */ - int exact) /* Non-zero means that only the particular - * version given is acceptable. Zero means use - * the latest compatible version. */ -{ - return Tcl_PkgPresentEx(interp, name, version, exact, NULL); -} - const char * Tcl_PkgPresentEx( Tcl_Interp *interp, /* Interpreter in which package is now @@ -1893,7 +1852,7 @@ Tcl_PkgInitStubsCheck( const char * version, int exact) { - const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0); + const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL); if (exact && actualVersion) { const char *p = version; @@ -1905,11 +1864,11 @@ Tcl_PkgInitStubsCheck( if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { /* Construct error message */ - Tcl_PkgPresent(interp, "Tcl", version, 1); + Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); return NULL; } } else { - return Tcl_PkgPresent(interp, "Tcl", version, 1); + return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL); } } return actualVersion; diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index 681854d..ebb9991 100644..100755 --- 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 @@ -52,19 +41,19 @@ extern "C" { #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, @@ -114,9 +103,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/tclPreserve.c b/generic/tclPreserve.c index 0bd8f93..62c8de4 100644 --- a/generic/tclPreserve.c +++ b/generic/tclPreserve.c @@ -53,7 +53,7 @@ TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */ * objects that we don't want to live any longer than necessary. */ -typedef struct HandleStruct { +typedef struct { void *ptr; /* Pointer to the memory block being tracked. * This field will become NULL when the memory * block is deleted. This field must be the diff --git a/generic/tclProc.c b/generic/tclProc.c index 1314719..db726c4 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -2871,7 +2871,8 @@ Tcl_DisassembleObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "type ..."); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){ + if (Tcl_GetIndexFromObjStruct(interp, objv[1], types, + sizeof(char *), "type", 0, &idx) != TCL_OK){ return TCL_ERROR; } diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 6348e4a..030be1d 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -64,7 +64,7 @@ #define NUM_REGEXPS 30 -typedef struct ThreadSpecificData { +typedef struct { int initialized; /* Set to 1 when the module is initialized. */ char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular * expression patterns. NULL means that this @@ -672,7 +672,7 @@ TclRegAbout( resultObj = Tcl_NewObj(); Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewIntObj((int) regexpPtr->re.re_nsub)); + Tcl_NewLongObj((long) regexpPtr->re.re_nsub)); /* * Now append a list of all the bit-flags set for the RE. diff --git a/generic/tclResult.c b/generic/tclResult.c index 2f2563a..ea30ce5 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 @@ -35,7 +34,7 @@ static void SetupAppendBuffer(Interp *iPtr, int newSpace); * then back up to the result or the error that was previously in progress. */ -typedef struct InterpState { +typedef struct { int status; /* return code status */ int flags; /* Each remaining field saves the */ int returnLevel; /* corresponding field of the Interp */ @@ -211,188 +210,6 @@ Tcl_DiscardInterpState( /* *---------------------------------------------------------------------- * - * Tcl_SaveResult -- - * - * Takes a snapshot of the current result state of the interpreter. The - * snapshot can be restored at any point by Tcl_RestoreResult. Note that - * this routine does not preserve the errorCode, errorInfo, or flags - * fields so it should not be used if an error is in progress. - * - * Once a snapshot is saved, it must be restored by calling - * Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult. - * - * Results: - * None. - * - * Side effects: - * Resets the interpreter result. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_SaveResult -void -Tcl_SaveResult( - Tcl_Interp *interp, /* Interpreter to save. */ - Tcl_SavedResult *statePtr) /* Pointer to state structure. */ -{ - Interp *iPtr = (Interp *) interp; - - /* - * Move the result object into the save state. Note that we don't need to - * change its refcount because we're moving it, not adding a new - * reference. Put an empty object into the interpreter. - */ - - 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; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_RestoreResult -- - * - * Restores the state of the interpreter to a snapshot taken by - * Tcl_SaveResult. After this call, the token for the interpreter state - * is no longer valid. - * - * Results: - * None. - * - * Side effects: - * Restores the interpreter result. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_RestoreResult -void -Tcl_RestoreResult( - Tcl_Interp *interp, /* Interpreter being restored. */ - Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */ -{ - Interp *iPtr = (Interp *) interp; - - Tcl_ResetResult(interp); - - /* - * Restore the string result. - */ - - iPtr->freeProc = statePtr->freeProc; - if (statePtr->result == statePtr->resultSpace) { - /* - * Copy the static string data into the interp buffer. - */ - - iPtr->result = iPtr->resultSpace; - strcpy(iPtr->result, statePtr->result); - } else if (statePtr->result == statePtr->appendResult) { - /* - * Move the append buffer back into the interp. - */ - - if (iPtr->appendResult != NULL) { - ckfree(iPtr->appendResult); - } - - iPtr->appendResult = statePtr->appendResult; - iPtr->appendAvl = statePtr->appendAvl; - iPtr->appendUsed = statePtr->appendUsed; - iPtr->result = iPtr->appendResult; - } else { - /* - * Move the dynamic or static string back into the interpreter. - */ - - iPtr->result = statePtr->result; - } - - /* - * Restore the object result. - */ - - Tcl_DecrRefCount(iPtr->objResultPtr); - iPtr->objResultPtr = statePtr->objResultPtr; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_DiscardResult -- - * - * Frees the memory associated with an interpreter snapshot taken by - * Tcl_SaveResult. If the snapshot is not restored, this function must be - * called to discard it, or the memory will be lost. - * - * Results: - * None. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_DiscardResult -void -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); - } -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetResult -- * * Arrange for "result" to be the Tcl return value. @@ -417,49 +234,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); } /* @@ -483,18 +266,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); } /* @@ -535,21 +309,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; } /* @@ -578,32 +337,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; } @@ -640,23 +374,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 */ } /* @@ -722,129 +439,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); } /* @@ -853,18 +461,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). * *---------------------------------------------------------------------- */ @@ -875,15 +482,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); } @@ -913,16 +511,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) { @@ -1112,7 +700,6 @@ Tcl_SetObjErrorCode( *---------------------------------------------------------------------- */ -#undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) @@ -1130,7 +717,6 @@ Tcl_GetErrorLine( *---------------------------------------------------------------------- */ -#undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, diff --git a/generic/tclScan.c b/generic/tclScan.c index 4dfc2d6..ec54ddb 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -28,7 +28,7 @@ * character set. */ -typedef struct CharSet { +typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 883e2ea..30a72ba 100644 --- 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/tclStringObj.c b/generic/tclStringObj.c index e495c2e..16d0a17 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -104,7 +104,7 @@ const Tcl_ObjType tclStringType = { * tcl.h, but do not do that unless you are sure what you're doing! */ -typedef struct String { +typedef struct { int numChars; /* The number of chars in the string. -1 means * this value has not been calculated. >= 0 * means that there is a valid Unicode rep, or @@ -2069,7 +2069,7 @@ Tcl_AppendFormatToObj( const char *bytes; if (useShort) { - pure = Tcl_NewIntObj((int) s); + pure = Tcl_NewLongObj((long) s); } else if (useWide) { pure = Tcl_NewWideIntObj(w); } else if (useBig) { @@ -2543,7 +2543,7 @@ AppendPrintfToObjVA( break; case '*': lastNum = (int) va_arg(argList, int); - Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum)); + Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(lastNum)); p++; break; case '0': case '1': case '2': case '3': case '4': diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 3f1c27b..b430456 100644..100755 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -10,8 +10,16 @@ */ #include "tclInt.h" +#include "tclOOInt.h" #include "tommath.h" +/* + * The actual definition of the variable holding the TclOO stub table. + */ + +MODULE_SCOPE const TclOOStubs tclOOStubs; +MODULE_SCOPE const TclOOIntStubs tclOOIntStubs; + #ifdef __GNUC__ #pragma GCC dependency "tcl.decls" #pragma GCC dependency "tclInt.decls" @@ -25,10 +33,8 @@ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc -#undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj -#undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_NewObj @@ -37,64 +43,37 @@ #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry -#undef Tcl_Panic -#undef Tcl_FindExecutable #undef TclpGetPid -#undef TclSockMinimumBuffers -#define TclBackgroundException Tcl_BackgroundException +#undef TclPkgProvide #undef Tcl_SetIntObj -#undef TclpInetNtoa - -/* 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) +#define TclPkgProvide pkgProvide +static int TclPkgProvide( + Tcl_Interp *interp, /* Interpreter in which package is now + * available. */ + const char *name, /* Name of package. */ + const char *version) /* Version string for package. */ { - Tcl_SetStartupScript(path, NULL); -} -#define TclGetStartupScriptPath getStartupScriptPath -static Tcl_Obj *TclGetStartupScriptPath(void) -{ - return Tcl_GetStartupScript(NULL); -} -#define TclSetStartupScriptFileName setStartupScriptFileName -static void TclSetStartupScriptFileName( - const char *fileName) -{ - Tcl_SetStartupScript(Tcl_NewStringObj(fileName,-1), NULL); -} -#define TclGetStartupScriptFileName getStartupScriptFileName -static const char *TclGetStartupScriptFileName(void) -{ - Tcl_Obj *path = Tcl_GetStartupScript(NULL); - if (path == NULL) { - return NULL; - } - return Tcl_GetStringFromObj(path, NULL); + /* In Tcl 9, Tcl_PkgProvide is a macro calling Tcl_PkgProvideEx. + * The only way this stub can be called is by an extension compiled + * against Tcl 8 headers. The Tcl_StubsInit() function already + * succeeded, so the extension author lied: It did something like: + * Tcl_StubsInit(interp, "8.6-", 0) + * or + * Tcl_StubsInit(interp, "8.6-9.1", 0) + * + * The best we can do is provide an error-message, as if the + * extension originally called: + * Tcl_StubsInit(interp, "8", 0) + */ + Tcl_PkgRequireEx(interp, "Tcl", "8", 0, NULL); + return TCL_ERROR; } -#if defined(_WIN32) || defined(__CYGWIN__) -#undef TclWinNToHS -#define TclWinNToHS winNToHS -static unsigned short TclWinNToHS(unsigned short ns) { - return ntohs(ns); -} -#endif - #ifdef __WIN32__ # define TclUnixWaitForFile 0 # define TclUnixCopyFile 0 # define TclUnixOpenTemporaryFile 0 -# define TclpReaddir 0 # define TclpIsAtty 0 #elif defined(__CYGWIN__) # define TclpIsAtty TclPlatIsAtty @@ -258,22 +237,6 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ return result; } #define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj -static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp -static int utfNcmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp -static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){ - return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n); -} -#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp -static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){ - return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n); -} -#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp static int formatInt(char *buffer, int n){ return TclFormatInt(buffer, (long)n); } @@ -281,9 +244,6 @@ static int formatInt(char *buffer, int n){ #endif -#else /* UNIX and MAC */ -# define TclpLocaltime_unix TclpLocaltime -# define TclpGmtime_unix TclpGmtime #endif /* @@ -308,7 +268,7 @@ static const TclIntStubs tclIntStubs = { TclCleanupChildren, /* 5 */ TclCleanupCommand, /* 6 */ TclCopyAndCollapse, /* 7 */ - TclCopyChannelOld, /* 8 */ + 0, /* 8 */ TclCreatePipeline, /* 9 */ TclCreateProc, /* 10 */ TclDeleteCompiledLocalVars, /* 11 */ @@ -377,7 +337,7 @@ static const TclIntStubs tclIntStubs = { TclpFree, /* 74 */ TclpGetClicks, /* 75 */ TclpGetSeconds, /* 76 */ - TclpGetTime, /* 77 */ + 0, /* 77 */ 0, /* 78 */ 0, /* 79 */ 0, /* 80 */ @@ -404,7 +364,7 @@ static const TclIntStubs tclIntStubs = { TclSetPreInitScript, /* 101 */ TclSetupEnv, /* 102 */ TclSockGetPort, /* 103 */ - TclSockMinimumBuffersOld, /* 104 */ + 0, /* 104 */ 0, /* 105 */ 0, /* 106 */ 0, /* 107 */ @@ -412,28 +372,28 @@ static const TclIntStubs tclIntStubs = { TclUpdateReturnInfo, /* 109 */ TclSockMinimumBuffers, /* 110 */ Tcl_AddInterpResolvers, /* 111 */ - Tcl_AppendExportList, /* 112 */ - Tcl_CreateNamespace, /* 113 */ - Tcl_DeleteNamespace, /* 114 */ - Tcl_Export, /* 115 */ - Tcl_FindCommand, /* 116 */ - Tcl_FindNamespace, /* 117 */ + 0, /* 112 */ + 0, /* 113 */ + 0, /* 114 */ + 0, /* 115 */ + 0, /* 116 */ + 0, /* 117 */ Tcl_GetInterpResolvers, /* 118 */ Tcl_GetNamespaceResolvers, /* 119 */ Tcl_FindNamespaceVar, /* 120 */ - Tcl_ForgetImport, /* 121 */ - Tcl_GetCommandFromObj, /* 122 */ - Tcl_GetCommandFullName, /* 123 */ - Tcl_GetCurrentNamespace, /* 124 */ - Tcl_GetGlobalNamespace, /* 125 */ + 0, /* 121 */ + 0, /* 122 */ + 0, /* 123 */ + 0, /* 124 */ + 0, /* 125 */ Tcl_GetVariableFullName, /* 126 */ - Tcl_Import, /* 127 */ + 0, /* 127 */ Tcl_PopCallFrame, /* 128 */ Tcl_PushCallFrame, /* 129 */ Tcl_RemoveInterpResolvers, /* 130 */ Tcl_SetNamespaceResolvers, /* 131 */ TclpHasSockets, /* 132 */ - TclpGetDate, /* 133 */ + 0, /* 133 */ 0, /* 134 */ 0, /* 135 */ 0, /* 136 */ @@ -458,8 +418,8 @@ static const TclIntStubs tclIntStubs = { 0, /* 155 */ TclRegError, /* 156 */ TclVarTraceExists, /* 157 */ - TclSetStartupScriptFileName, /* 158 */ - TclGetStartupScriptFileName, /* 159 */ + 0, /* 158 */ + 0, /* 159 */ 0, /* 160 */ TclChannelTransform, /* 161 */ TclChannelEventScriptInvoker, /* 162 */ @@ -467,8 +427,8 @@ static const TclIntStubs tclIntStubs = { TclExpandCodeArray, /* 164 */ TclpSetInitialEncodings, /* 165 */ TclListObjSetElement, /* 166 */ - TclSetStartupScriptPath, /* 167 */ - TclGetStartupScriptPath, /* 168 */ + 0, /* 167 */ + 0, /* 168 */ TclpUtfNcmp2, /* 169 */ TclCheckInterpTraces, /* 170 */ TclCheckExecutionTraces, /* 171 */ @@ -478,12 +438,12 @@ static const TclIntStubs tclIntStubs = { TclCallVarTraces, /* 175 */ TclCleanupVar, /* 176 */ TclVarErrMsg, /* 177 */ - Tcl_SetStartupScript, /* 178 */ - Tcl_GetStartupScript, /* 179 */ + 0, /* 178 */ + 0, /* 179 */ 0, /* 180 */ 0, /* 181 */ - TclpLocaltime, /* 182 */ - TclpGmtime, /* 183 */ + 0, /* 182 */ + 0, /* 183 */ 0, /* 184 */ 0, /* 185 */ 0, /* 186 */ @@ -536,7 +496,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + 0, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -567,10 +527,10 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 10 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ 0, /* 15 */ 0, /* 16 */ @@ -591,16 +551,16 @@ static const TclIntPlatStubs tclIntPlatStubs = { #endif /* UNIX */ #if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */ TclWinConvertError, /* 0 */ - TclWinConvertWSAError, /* 1 */ + 0, /* 1 */ TclWinGetServByName, /* 2 */ TclWinGetSockOpt, /* 3 */ TclWinGetTclInstance, /* 4 */ TclUnixWaitForFile, /* 5 */ - TclWinNToHS, /* 6 */ + 0, /* 6 */ TclWinSetSockOpt, /* 7 */ TclpGetPid, /* 8 */ TclWinGetPlatformId, /* 9 */ - TclpReaddir, /* 10 */ + 0, /* 10 */ TclGetAndDetachPids, /* 11 */ TclpCloseFile, /* 12 */ TclpCreateCommandChannel, /* 13 */ @@ -611,7 +571,7 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 18 */ TclpOpenFile, /* 19 */ TclWinAddProcess, /* 20 */ - TclpInetNtoa, /* 21 */ + 0, /* 21 */ TclpCreateTempFile, /* 22 */ 0, /* 23 */ TclWinNoBackslash, /* 24 */ @@ -633,10 +593,10 @@ static const TclIntPlatStubs tclIntPlatStubs = { TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ TclpCreateTempFile, /* 9 */ - TclpReaddir, /* 10 */ - TclpLocaltime_unix, /* 11 */ - TclpGmtime_unix, /* 12 */ - TclpInetNtoa, /* 13 */ + 0, /* 10 */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ TclUnixCopyFile, /* 14 */ TclMacOSXGetFileAttribute, /* 15 */ TclMacOSXSetFileAttribute, /* 16 */ @@ -742,7 +702,9 @@ const TclTomMathStubs tclTomMathStubs = { static const TclStubHooks tclStubHooks = { &tclPlatStubs, &tclIntStubs, - &tclIntPlatStubs + &tclIntPlatStubs, + &tclOOStubs, + &tclOOIntStubs }; const TclStubs tclStubs = { @@ -800,7 +762,7 @@ const TclStubs tclStubs = { Tcl_GetByteArrayFromObj, /* 33 */ Tcl_GetDouble, /* 34 */ Tcl_GetDoubleFromObj, /* 35 */ - Tcl_GetIndexFromObj, /* 36 */ + 0, /* 36 */ Tcl_GetInt, /* 37 */ Tcl_GetIntFromObj, /* 38 */ Tcl_GetLongFromObj, /* 39 */ @@ -831,7 +793,7 @@ const TclStubs tclStubs = { Tcl_SetObjLength, /* 64 */ Tcl_SetStringObj, /* 65 */ Tcl_AddErrorInfo, /* 66 */ - Tcl_AddObjErrorInfo, /* 67 */ + 0, /* 67 */ Tcl_AllowExceptions, /* 68 */ Tcl_AppendElement, /* 69 */ Tcl_AppendResult, /* 70 */ @@ -841,7 +803,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 */ @@ -859,7 +821,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 */ @@ -893,9 +855,9 @@ const TclStubs tclStubs = { Tcl_Eof, /* 126 */ Tcl_ErrnoId, /* 127 */ Tcl_ErrnoMsg, /* 128 */ - Tcl_Eval, /* 129 */ - Tcl_EvalFile, /* 130 */ - Tcl_EvalObj, /* 131 */ + 0, /* 129 */ + 0, /* 130 */ + 0, /* 131 */ Tcl_EventuallyFree, /* 132 */ Tcl_Exit, /* 133 */ Tcl_ExposeCommand, /* 134 */ @@ -908,7 +870,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 */ @@ -947,10 +909,10 @@ const TclStubs tclStubs = { Tcl_GetSlave, /* 172 */ Tcl_GetStdChannel, /* 173 */ Tcl_GetStringResult, /* 174 */ - Tcl_GetVar, /* 175 */ + 0, /* 175 */ Tcl_GetVar2, /* 176 */ - Tcl_GlobalEval, /* 177 */ - Tcl_GlobalEvalObj, /* 178 */ + 0, /* 177 */ + 0, /* 178 */ Tcl_HideCommand, /* 179 */ Tcl_Init, /* 180 */ Tcl_InitHashTable, /* 181 */ @@ -992,7 +954,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 */ @@ -1002,14 +964,14 @@ const TclStubs tclStubs = { Tcl_SetErrno, /* 227 */ Tcl_SetErrorCode, /* 228 */ Tcl_SetMaxBlockTime, /* 229 */ - Tcl_SetPanicProc, /* 230 */ + 0, /* 230 */ Tcl_SetRecursionLimit, /* 231 */ Tcl_SetResult, /* 232 */ Tcl_SetServiceMode, /* 233 */ Tcl_SetObjErrorCode, /* 234 */ Tcl_SetObjResult, /* 235 */ Tcl_SetStdChannel, /* 236 */ - Tcl_SetVar, /* 237 */ + 0, /* 237 */ Tcl_SetVar2, /* 238 */ Tcl_SignalId, /* 239 */ Tcl_SignalMsg, /* 240 */ @@ -1018,22 +980,22 @@ const TclStubs tclStubs = { Tcl_SplitPath, /* 243 */ Tcl_StaticPackage, /* 244 */ Tcl_StringMatch, /* 245 */ - Tcl_TellOld, /* 246 */ - Tcl_TraceVar, /* 247 */ + 0, /* 246 */ + 0, /* 247 */ Tcl_TraceVar2, /* 248 */ Tcl_TranslateFileName, /* 249 */ Tcl_Ungets, /* 250 */ Tcl_UnlinkVar, /* 251 */ Tcl_UnregisterChannel, /* 252 */ - Tcl_UnsetVar, /* 253 */ + 0, /* 253 */ Tcl_UnsetVar2, /* 254 */ - Tcl_UntraceVar, /* 255 */ + 0, /* 255 */ Tcl_UntraceVar2, /* 256 */ Tcl_UpdateLinkedVar, /* 257 */ - Tcl_UpVar, /* 258 */ + 0, /* 258 */ Tcl_UpVar2, /* 259 */ - Tcl_VarEval, /* 260 */ - Tcl_VarTraceInfo, /* 261 */ + 0, /* 260 */ + 0, /* 261 */ Tcl_VarTraceInfo2, /* 262 */ Tcl_Write, /* 263 */ Tcl_WrongNumArgs, /* 264 */ @@ -1043,12 +1005,12 @@ const TclStubs tclStubs = { Tcl_AppendStringsToObjVA, /* 268 */ Tcl_HashStats, /* 269 */ Tcl_ParseVar, /* 270 */ - Tcl_PkgPresent, /* 271 */ + 0, /* 271 */ Tcl_PkgPresentEx, /* 272 */ - Tcl_PkgProvide, /* 273 */ - Tcl_PkgRequire, /* 274 */ + TclPkgProvide, /* 273 */ + 0, /* 274 */ Tcl_SetErrorCodeVA, /* 275 */ - Tcl_VarEvalVA, /* 276 */ + 0, /* 276 */ Tcl_WaitPid, /* 277 */ Tcl_PanicVA, /* 278 */ Tcl_GetVersion, /* 279 */ @@ -1062,7 +1024,7 @@ const TclStubs tclStubs = { Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ - Tcl_DiscardResult, /* 290 */ + 0, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ Tcl_EvalObjEx, /* 293 */ @@ -1086,8 +1048,8 @@ const TclStubs tclStubs = { Tcl_ConditionWait, /* 311 */ Tcl_NumUtfChars, /* 312 */ Tcl_ReadChars, /* 313 */ - Tcl_RestoreResult, /* 314 */ - Tcl_SaveResult, /* 315 */ + 0, /* 314 */ + 0, /* 315 */ Tcl_SetSystemEncoding, /* 316 */ Tcl_SetVar2Ex, /* 317 */ Tcl_ThreadAlert, /* 318 */ @@ -1113,8 +1075,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 */ @@ -1129,7 +1091,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 */ @@ -1207,8 +1169,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..a76c7fb 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.c @@ -12,25 +12,27 @@ */ #include "tclInt.h" +#include "tclOOInt.h" MODULE_SCOPE const TclStubs *tclStubsPtr; MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr; MODULE_SCOPE const TclIntStubs *tclIntStubsPtr; MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr; +MODULE_SCOPE const TclOOStubs *tclOOStubsPtr; +MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr; const TclStubs *tclStubsPtr = NULL; const TclPlatStubs *tclPlatStubsPtr = NULL; const TclIntStubs *tclIntStubsPtr = NULL; const TclIntPlatStubs *tclIntPlatStubsPtr = NULL; +const TclOOStubs *tclOOStubsPtr = NULL; +const TclOOIntStubs *tclOOIntStubsPtr = NULL; /* - * Use our own isDigit to avoid linking to libc on windows + * Use our own ISDIGIT to avoid linking to libc on windows */ -static int isDigit(const int c) -{ - return (c >= '0' && c <= '9'); -} +#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9) /* *---------------------------------------------------------------------- @@ -54,7 +56,9 @@ MODULE_SCOPE const char * Tcl_InitStubs( 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 +72,8 @@ 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; } @@ -77,12 +81,12 @@ Tcl_InitStubs( if (actualVersion == NULL) { return NULL; } - if (exact) { + if (exact&1) { const char *p = version; int count = 0; while (*p) { - count += !isDigit(*p++); + count += !ISDIGIT(*p++); } if (count == 1) { const char *q = actualVersion; @@ -91,7 +95,7 @@ Tcl_InitStubs( while (*p && (*p == *q)) { p++; q++; } - if (*p || isDigit(*q)) { + if (*p || ISDIGIT(*q)) { /* Construct error message */ stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; @@ -103,16 +107,25 @@ Tcl_InitStubs( } } } - tclStubsPtr = (TclStubs *)pkgData; - if (tclStubsPtr->hooks) { - tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs; - tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs; - tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs; + if (stubsPtr->reserved77) { + /* We are running Tcl 8.x */ + stubsPtr = (TclStubs *)pkgData; + } + tclStubsPtr = stubsPtr; + + if (stubsPtr->hooks) { + tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs; + tclIntStubsPtr = stubsPtr->hooks->tclIntStubs; + tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs; + tclOOStubsPtr = stubsPtr->hooks->tclOOStubs; + tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs; } else { tclPlatStubsPtr = NULL; tclIntStubsPtr = NULL; tclIntPlatStubsPtr = NULL; + tclOOStubsPtr = NULL; + tclOOIntStubsPtr = NULL; } return actualVersion; diff --git a/generic/tclTest.c b/generic/tclTest.c index f121d0d..879406d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -42,16 +42,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 @@ -98,7 +90,7 @@ static Tcl_Trace cmdTrace; * TestdelCmd: */ -typedef struct DelCmd { +typedef struct { Tcl_Interp *interp; /* Interpreter in which command exists. */ char *deleteCmd; /* Script to execute when command is deleted. * Malloc'ed. */ @@ -109,20 +101,13 @@ typedef struct DelCmd { * command. */ -typedef struct TclEncoding { +typedef struct { Tcl_Interp *interp; char *toUtfCmd; char *fromUtfCmd; } 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. */ @@ -132,7 +117,7 @@ static int exitMainLoop = 0; * Event structure used in testing the event queue management procedures. */ -typedef struct TestEvent { +typedef struct { Tcl_Event header; /* Header common to all events */ Tcl_Interp *interp; /* Interpreter that will handle the event */ Tcl_Obj *command; /* Command to evaluate when the event occurs */ @@ -294,12 +279,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, @@ -327,12 +306,10 @@ static int TestreturnObjCmd(ClientData dummy, Tcl_Obj *const objv[]); static void TestregexpXflags(const char *string, int length, int *cflagsPtr, int *eflagsPtr); -#ifndef TCL_NO_DEPRECATED static int TestsaveresultCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static void TestsaveresultFree(char *blockPtr); -#endif /* TCL_NO_DEPRECATED */ static int TestsetassocdataCmd(ClientData dummy, Tcl_Interp *interp, int argc, const char **argv); static int TestsetCmd(ClientData dummy, @@ -525,10 +502,6 @@ int Tcltest_Init( Tcl_Interp *interp) /* Interpreter for application. */ { -#ifndef TCL_NO_DEPRECATED - Tcl_ValueType t3ArgTypes[2]; -#endif /* TCL_NO_DEPRECATED */ - Tcl_Obj *listPtr; Tcl_Obj **objv; int objc, index; @@ -537,10 +510,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) { @@ -548,7 +521,7 @@ Tcltest_Init( } /* TIP #268: Full patchlevel instead of just major.minor */ - if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) { + if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) { return TCL_ERROR; } @@ -646,10 +619,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd, NULL, NULL); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd, @@ -671,10 +642,7 @@ Tcltest_Init( Tcl_CreateCommand(interp, "testtranslatefilename", TesttranslatefilenameCmd, NULL, NULL); Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL); -#ifndef TCL_NO_DEPRECATED - Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123); - Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345); -#endif /* TCL_NO_DEPRECATED */ + Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd, @@ -685,12 +653,6 @@ Tcltest_Init( Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, (ClientData) 0, NULL); #endif -#ifndef TCL_NO_DEPRECATED - t3ArgTypes[0] = TCL_EITHER; - t3ArgTypes[1] = TCL_EITHER; - Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, - NULL); -#endif /* TCL_NO_DEPRECATED */ Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); @@ -718,8 +680,8 @@ Tcltest_Init( if (Tcl_ListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { return TCL_ERROR; } - if (objc && (Tcl_GetIndexFromObj(NULL, objv[0], specialOptions, NULL, - TCL_EXACT, &index) == TCL_OK)) { + if (objc && (Tcl_GetIndexFromObjStruct(NULL, objv[0], specialOptions, + sizeof(char *), NULL, TCL_EXACT, &index) == TCL_OK)) { switch (index) { case 0: return TCL_ERROR; @@ -809,7 +771,7 @@ TestasyncCmd( if (argc < 2) { wrongNumArgs: - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "create") == 0) { @@ -827,7 +789,7 @@ TestasyncCmd( asyncPtr->nextPtr = firstHandler; firstHandler = asyncPtr; Tcl_MutexUnlock(&asyncTestMutex); - Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(asyncPtr->id)); } else if (strcmp(argv[1], "delete") == 0) { if (argc == 2) { Tcl_MutexLock(&asyncTestMutex); @@ -899,7 +861,7 @@ TestasyncCmd( if (Tcl_CreateThread(&threadID, AsyncThreadProc, INT2PTR(id), TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS) != TCL_OK) { - Tcl_SetResult(interp, "can't create thread", TCL_STATIC); + Tcl_AppendResult(interp, "can't create thread", NULL); Tcl_MutexUnlock(&asyncTestMutex); return TCL_ERROR; } @@ -923,7 +885,7 @@ TestasyncCmd( static int AsyncHandlerProc( - ClientData clientData, /* If of TestAsyncHandler structure. + ClientData clientData, /* If of TestAsyncHandler structure. * in global list. */ Tcl_Interp *interp, /* Interpreter in which command was * executed, or NULL. */ @@ -953,7 +915,7 @@ AsyncHandlerProc( listArgv[3] = NULL; cmd = Tcl_Merge(3, listArgv); if (interp != NULL) { - code = Tcl_Eval(interp, cmd); + code = Tcl_EvalEx(interp, cmd, -1, 0); } else { /* * this should not happen, but by definition of how async handlers are @@ -1046,7 +1008,7 @@ TestcmdinfoCmd( Tcl_DStringResult(interp, &delString); } else if (strcmp(argv[1], "get") == 0) { if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) { - Tcl_SetResult(interp, "??", TCL_STATIC); + Tcl_AppendResult(interp, "??", NULL); return TCL_OK; } if (info.proc == CmdProc1) { @@ -1081,9 +1043,9 @@ TestcmdinfoCmd( info.deleteProc = CmdDelProc2; info.deleteData = (ClientData) "new_delete_data"; if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(0)); } else { - Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(1)); } } else { Tcl_AppendResult(interp, "bad option \"", argv[1], @@ -1173,7 +1135,7 @@ TestcmdtokenCmd( token = Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original", NULL); sprintf(buf, "%p", (void *)token); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "name") == 0) { Tcl_Obj *objPtr; @@ -1236,7 +1198,7 @@ TestcmdtraceCmd( if (strcmp(argv[1], "tracetest") == 0) { Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1252,13 +1214,13 @@ TestcmdtraceCmd( */ cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL); - Tcl_Eval(interp, argv[2]); + Tcl_EvalEx(interp, argv[2], -1, 0); } else if (strcmp(argv[1], "leveltest") == 0) { Interp *iPtr = (Interp *) interp; Tcl_DStringInit(&buffer); cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1276,10 +1238,10 @@ TestcmdtraceCmd( cmdTrace = Tcl_CreateObjTrace(interp, 50000, TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc, (ClientData) &deleteCalled, ObjTraceDeleteProc); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); Tcl_DeleteTrace(interp, cmdTrace); if (!deleteCalled) { - Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC); + Tcl_AppendResult(interp, "Delete wasn't called", NULL); return TCL_ERROR; } else { return result; @@ -1290,7 +1252,7 @@ TestcmdtraceCmd( Tcl_DStringInit(&buffer); t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer); t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer); - result = Tcl_Eval(interp, argv[2]); + result = Tcl_EvalEx(interp, argv[2], -1, 0); if (result == TCL_OK) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL); @@ -1579,7 +1541,7 @@ TestdelCmd( Tcl_Interp *slave; if (argc != 4) { - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } @@ -1619,7 +1581,7 @@ DelDeleteProc( { DelCmd *dPtr = clientData; - Tcl_Eval(dPtr->interp, dPtr->deleteCmd); + Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0); Tcl_ResetResult(dPtr->interp); ckfree(dPtr->deleteCmd); ckfree(dPtr); @@ -1731,8 +1693,8 @@ TestdoubledigitsObjCmd(ClientData unused, } if (status != TCL_OK || Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK - || Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type", - TCL_EXACT, &type) != TCL_OK) { + || Tcl_GetIndexFromObjStruct(interp, objv[3], options, + sizeof(char *), "conversion type", TCL_EXACT, &type) != TCL_OK) { fprintf(stderr, "bad value? %g\n", d); return TCL_ERROR; } @@ -1748,7 +1710,7 @@ TestdoubledigitsObjCmd(ClientData unused, strObj = Tcl_NewStringObj(str, endPtr-str); ckfree(str); retval = Tcl_NewListObj(1, &strObj); - Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt)); + Tcl_ListObjAppendElement(NULL, retval, Tcl_NewLongObj(decpt)); strObj = Tcl_NewStringObj(signum ? "-" : "+", 1); Tcl_ListObjAppendElement(NULL, retval, strObj); Tcl_SetObjResult(interp, retval); @@ -1784,7 +1746,7 @@ TestdstringCmd( if (argc < 2) { wrongNumArgs: - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } if (strcmp(argv[1], "append") == 0) { @@ -1820,9 +1782,9 @@ TestdstringCmd( goto wrongNumArgs; } if (strcmp(argv[2], "staticsmall") == 0) { - Tcl_SetResult(interp, "short", TCL_STATIC); + Tcl_AppendResult(interp, "short", NULL); } else if (strcmp(argv[2], "staticlarge") == 0) { - Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC); + Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL); } else if (strcmp(argv[2], "free") == 0) { char *s = ckalloc(100); strcpy(s, "This is a malloc-ed string"); @@ -1843,7 +1805,7 @@ TestdstringCmd( if (argc != 2) { goto wrongNumArgs; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_DStringLength(&dstring))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_DStringLength(&dstring))); } else if (strcmp(argv[1], "result") == 0) { if (argc != 2) { goto wrongNumArgs; @@ -1918,8 +1880,8 @@ TestencodingObjCmd( ENC_CREATE, ENC_DELETE }; - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -1982,7 +1944,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) { @@ -2014,7 +1976,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) { @@ -2178,8 +2140,8 @@ TesteventObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand", - TCL_EXACT, &subCmdIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands, + sizeof(char *), "subcommand", TCL_EXACT, &subCmdIndex) != TCL_OK) { return TCL_ERROR; } switch (subCmdIndex) { @@ -2188,8 +2150,8 @@ TesteventObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "name position script"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[3], positions, - "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[3], positions, + sizeof(char *), "position specifier", TCL_EXACT, &posIndex) != TCL_OK) { return TCL_ERROR; } ev = ckalloc(sizeof(TestEvent)); @@ -2422,7 +2384,7 @@ TestexprlongCmd( " expression\"", NULL); return TCL_ERROR; } - Tcl_SetResult(interp, "This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprLong(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; @@ -2464,7 +2426,7 @@ TestexprlongobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } - Tcl_SetResult(interp, "This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprLongObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; @@ -2507,7 +2469,7 @@ TestexprdoubleCmd( " expression\"", NULL); return TCL_ERROR; } - Tcl_SetResult(interp, "This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprDouble(interp, argv[1], &exprResult); if (result != TCL_OK) { return result; @@ -2550,7 +2512,7 @@ TestexprdoubleobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "expression"); return TCL_ERROR; } - Tcl_SetResult(interp, "This is a result", TCL_STATIC); + Tcl_AppendResult(interp, "This is a result", NULL); result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult); if (result != TCL_OK) { return result; @@ -3292,8 +3254,8 @@ TestlocaleCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -3312,144 +3274,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 @@ -3628,7 +3452,7 @@ PrintParse( Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize)); Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewIntObj(parsePtr->numWords)); + Tcl_NewLongObj(parsePtr->numWords)); for (i = 0; i < parsePtr->numTokens; i++) { tokenPtr = &parsePtr->tokenPtr[i]; switch (tokenPtr->type) { @@ -3668,7 +3492,7 @@ PrintParse( Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewIntObj(tokenPtr->numComponents)); + Tcl_NewLongObj(tokenPtr->numComponents)); } Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize, @@ -3838,8 +3662,8 @@ TestregexpObjCmd( if (name[0] != '-') { break; } - if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], options, + sizeof(char *), "switch", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum options) index) { @@ -3914,7 +3738,7 @@ TestregexpObjCmd( * value 0. */ - Tcl_SetIntObj(Tcl_GetObjResult(interp), 0); + Tcl_SetLongObj(Tcl_GetObjResult(interp), 0); if (objc > 2 && (cflags®_EXPECT) && indices) { const char *varName; const char *value; @@ -4010,7 +3834,7 @@ TestregexpObjCmd( * Set the interpreter's object result to an integer object w/ value 1. */ - Tcl_SetIntObj(Tcl_GetObjResult(interp), 1); + Tcl_SetLongObj(Tcl_GetObjResult(interp), 1); return TCL_OK; } @@ -4405,7 +4229,7 @@ TestseterrorcodeCmd( const char **argv) /* Argument strings. */ { if (argc > 6) { - Tcl_SetResult(interp, "too many args", TCL_STATIC); + Tcl_AppendResult(interp, "too many args", NULL); return TCL_ERROR; } switch (argc) { @@ -4502,7 +4326,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 { @@ -4977,7 +4801,7 @@ TestsetCmd( const char *value; if (argc == 2) { - Tcl_SetResult(interp, "before get", TCL_STATIC); + Tcl_AppendResult(interp, "before get", NULL); value = Tcl_GetVar2(interp, argv[1], NULL, flags); if (value == NULL) { return TCL_ERROR; @@ -4985,7 +4809,7 @@ TestsetCmd( Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 3) { - Tcl_SetResult(interp, "before set", TCL_STATIC); + Tcl_AppendResult(interp, "before set", NULL); value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags); if (value == NULL) { return TCL_ERROR; @@ -5009,7 +4833,7 @@ Testset2Cmd( const char *value; if (argc == 3) { - Tcl_SetResult(interp, "before get", TCL_STATIC); + Tcl_AppendResult(interp, "before get", NULL); value = Tcl_GetVar2(interp, argv[1], argv[2], flags); if (value == NULL) { return TCL_ERROR; @@ -5017,7 +4841,7 @@ Testset2Cmd( Tcl_AppendElement(interp, value); return TCL_OK; } else if (argc == 4) { - Tcl_SetResult(interp, "before set", TCL_STATIC); + Tcl_AppendResult(interp, "before set", NULL); value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags); if (value == NULL) { return TCL_ERROR; @@ -5031,7 +4855,6 @@ Testset2Cmd( } } -#ifndef TCL_NO_DEPRECATED /* *---------------------------------------------------------------------- * @@ -5057,7 +4880,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; @@ -5076,8 +4898,8 @@ TestsaveresultCmd( Tcl_WrongNumArgs(interp, 1, objv, "type script discard"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) { @@ -5087,7 +4909,7 @@ TestsaveresultCmd( objPtr = NULL; /* Lint. */ switch ((enum options) index) { case RESULT_SMALL: - Tcl_SetResult(interp, "small result", TCL_VOLATILE); + Tcl_AppendResult(interp, "small result", NULL); break; case RESULT_APPEND: Tcl_AppendResult(interp, "append result", NULL); @@ -5108,13 +4930,12 @@ TestsaveresultCmd( break; } - freeCount = 0; Tcl_SaveResult(interp, &state); if (((enum options) index) == RESULT_OBJECT) { result = Tcl_EvalObjEx(interp, objv[2], 0); } else { - result = Tcl_Eval(interp, Tcl_GetString(objv[2])); + result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0); } if (discard) { @@ -5125,14 +4946,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"); @@ -5163,9 +4980,8 @@ static void TestsaveresultFree( char *blockPtr) { - freeCount++; + /* empty... */ } -#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- @@ -5197,7 +5013,7 @@ TestmainthreadCmd( Tcl_SetObjResult(interp, idObj); return TCL_OK; } else { - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } } @@ -5998,7 +5814,7 @@ TestWrongNumArgsObjCmd( * Don't use Tcl_WrongNumArgs here, as that is the function * we want to test! */ - Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC); + Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; } @@ -6015,7 +5831,7 @@ TestWrongNumArgsObjCmd( /* * Asked for more arguments than were given. */ - Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC); + Tcl_AppendResult(interp, "insufficient arguments", NULL); return TCL_ERROR; } @@ -6643,7 +6459,7 @@ TestNumUtfCharsCmd( (void) Tcl_GetStringFromObj(objv[1], &len); } len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len); - Tcl_SetObjResult(interp, Tcl_NewIntObj(len)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(len)); } return TCL_OK; } @@ -6697,7 +6513,7 @@ TestcpuidCmd( return status; } for (i=0 ; i<4 ; ++i) { - regsObjs[i] = Tcl_NewIntObj((int) regs[i]); + regsObjs[i] = Tcl_NewLongObj((int) regs[i]); } Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs)); return TCL_OK; @@ -6738,7 +6554,7 @@ TestHashSystemHashCmd( for (i=0 ; i<limit ; i++) { hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew); if (!isNew) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; @@ -6755,13 +6571,13 @@ TestHashSystemHashCmd( for (i=0 ; i<limit ; i++) { hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i)); if (hPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } if (PTR2INT(Tcl_GetHashValue(hPtr)) != i+42) { - Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(i)); Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem",-1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; @@ -6792,7 +6608,7 @@ TestgetintCmd( const char **argv) { if (argc < 2) { - Tcl_SetResult(interp, "wrong # args", TCL_STATIC); + Tcl_AppendResult(interp, "wrong # args", NULL); return TCL_ERROR; } else { int val, i, total=0; @@ -6803,7 +6619,7 @@ TestgetintCmd( } total += val; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(total)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(total)); return TCL_OK; } } @@ -6828,18 +6644,18 @@ TestNRELevels( depth = (refDepth - &depth); - levels[0] = Tcl_NewIntObj(depth); - levels[1] = Tcl_NewIntObj(iPtr->numLevels); - levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level); - levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level); - levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr + levels[0] = Tcl_NewLongObj(depth); + levels[1] = Tcl_NewLongObj(iPtr->numLevels); + levels[2] = Tcl_NewLongObj(iPtr->cmdFramePtr->level); + levels[3] = Tcl_NewLongObj(iPtr->varFramePtr->level); + levels[4] = Tcl_NewLongObj(iPtr->execEnvPtr->execStackPtr->tosPtr - iPtr->execEnvPtr->execStackPtr->stackWords); while (cbPtr) { i++; cbPtr = cbPtr->nextPtr; } - levels[5] = Tcl_NewIntObj(i); + levels[5] = Tcl_NewLongObj(i); Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels)); return TCL_OK; @@ -7186,8 +7002,8 @@ TestparseargsCmd( if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) { return TCL_ERROR; } - result[0] = Tcl_NewIntObj(foo); - result[1] = Tcl_NewIntObj(count); + result[0] = Tcl_NewLongObj(foo); + result[1] = Tcl_NewLongObj(count); result[2] = Tcl_NewListObj(count, remObjv); Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); ckfree(remObjv); @@ -7364,8 +7180,8 @@ TestInterpResolverCmd( Tcl_WrongNumArgs(interp, 1, objv, "up|down"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, - &idx) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], table, + sizeof(char *), "operation", TCL_EXACT, &idx) != TCL_OK) { return TCL_ERROR; } switch (idx) { diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index f36b07f..adc6063 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -47,7 +47,7 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp, static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -typedef struct TestString { +typedef struct { int numChars; int allocated; int maxChars; @@ -172,8 +172,8 @@ TestbignumobjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcmds, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } string = Tcl_GetString(objv[2]); @@ -346,9 +346,9 @@ TestbooleanobjCmd( */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetBooleanObj(varPtr[varIndex], boolValue); + Tcl_SetLongObj(varPtr[varIndex], boolValue!=0); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(boolValue!=0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "get") == 0) { @@ -371,9 +371,9 @@ TestbooleanobjCmd( return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetBooleanObj(varPtr[varIndex], !boolValue); + Tcl_SetLongObj(varPtr[varIndex], boolValue==0); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(boolValue==0)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { @@ -554,13 +554,14 @@ TestindexobjCmd( return TCL_ERROR; } - Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); + Tcl_GetIndexFromObjStruct(NULL, objv[1], tablePtr, + sizeof(char *), "token", 0, &index); indexRep = objv[1]->internalRep.twoPtrValue.ptr1; indexRep->index = index2; - result = Tcl_GetIndexFromObj(NULL, objv[1], - tablePtr, "token", 0, &index); + result = Tcl_GetIndexFromObjStruct(NULL, objv[1], + tablePtr, sizeof(char *), "token", 0, &index); if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetLongObj(Tcl_GetObjResult(interp), index); } return result; } @@ -598,11 +599,11 @@ TestindexobjCmd( } } - result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3], - argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index); + result = Tcl_GetIndexFromObjStruct((setError? interp : NULL), objv[3], + argv, sizeof(char *), "token", (allowAbbrev? 0 : TCL_EXACT), &index); ckfree(argv); if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetLongObj(Tcl_GetObjResult(interp), index); } return result; } @@ -669,9 +670,9 @@ TestintobjCmd( */ if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetIntObj(varPtr[varIndex], intValue); + Tcl_SetLongObj(varPtr[varIndex], intValue); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */ @@ -684,9 +685,9 @@ TestintobjCmd( } intValue = i; if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetIntObj(varPtr[varIndex], intValue); + Tcl_SetLongObj(varPtr[varIndex], intValue); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue)); + SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue)); } } else if (strcmp(subCmd, "setlong") == 0) { if (objc != 4) { @@ -780,9 +781,9 @@ TestintobjCmd( return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetIntObj(varPtr[varIndex], intValue * 10); + Tcl_SetLongObj(varPtr[varIndex], intValue * 10); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10)); + SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue * 10)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else if (strcmp(subCmd, "div10") == 0) { @@ -797,9 +798,9 @@ TestintobjCmd( return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { - Tcl_SetIntObj(varPtr[varIndex], intValue / 10); + Tcl_SetLongObj(varPtr[varIndex], intValue / 10); } else { - SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10)); + SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue / 10)); } Tcl_SetObjResult(interp, varPtr[varIndex]); } else { @@ -864,8 +865,8 @@ TestlistobjCmd( if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command", - 0, &cmdIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], subcommands, + sizeof(char *), "command", 0, &cmdIndex) != TCL_OK) { return TCL_ERROR; } switch(cmdIndex) { @@ -968,7 +969,7 @@ TestobjCmd( if (objc != 2) { goto wrongNumArgs; } - elemObjPtr = Tcl_NewIntObj(123); + elemObjPtr = Tcl_NewLongObj(123); listObjPtr = Tcl_NewListObj(1, &elemObjPtr); /* Replace the single list element through itself, nonsense but legal. */ Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr); @@ -1076,7 +1077,7 @@ TestobjCmd( if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(varPtr[varIndex]->refCount)); } else if (strcmp(subCmd, "type") == 0) { if (objc != 3) { goto wrongNumArgs; @@ -1161,8 +1162,8 @@ TeststringobjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option) - != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], options, + sizeof(char *), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } switch (option) { @@ -1240,7 +1241,7 @@ TeststringobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) + Tcl_SetLongObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL) ? varPtr[varIndex]->length : -1); break; case 5: /* length2 */ @@ -1255,7 +1256,7 @@ TeststringobjCmd( } else { length = -1; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), length); + Tcl_SetLongObj(Tcl_GetObjResult(interp), length); break; case 6: /* set */ if (objc != 4) { @@ -1309,7 +1310,7 @@ TeststringobjCmd( } else { length = -1; } - Tcl_SetIntObj(Tcl_GetObjResult(interp), length); + Tcl_SetLongObj(Tcl_GetObjResult(interp), length); break; case 10: /* getunicode */ if (objc != 3) { diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index a3f89f6..be510fc 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -34,7 +34,7 @@ static const char procCommand[] = "proc"; * procs */ -typedef struct CmdTable { +typedef struct { const char *cmdName; /* command name */ Tcl_ObjCmdProc *proc; /* command proc */ int exportIt; /* if 1, export the command */ @@ -143,7 +143,7 @@ RegisterCommand( if (cmdTablePtr->exportIt) { sprintf(buf, "namespace eval %s { namespace export %s }", namespace, cmdTablePtr->cmdName); - if (Tcl_Eval(interp, buf) != TCL_OK) { + if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) { return TCL_ERROR; } } @@ -185,7 +185,7 @@ ProcBodyTestInitInternal( } } - return Tcl_PkgProvide(interp, packageName, packageVersion); + return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL); } /* diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index abd5af5..438efc5 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -82,7 +82,7 @@ typedef union Block { * and statistics information. */ -typedef struct Bucket { +typedef struct { Block *firstPtr; /* First block available */ long numFree; /* Number of blocks available */ diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c index f24e334..36bf0a5 100644 --- a/generic/tclThreadStorage.c +++ b/generic/tclThreadStorage.c @@ -47,7 +47,7 @@ static struct TSDMaster { * The type of the data held per thread in a system TSD. */ -typedef struct TSDTable { +typedef struct { ClientData *tablePtr; /* The table of Tcl TSDs. */ sig_atomic_t allocated; /* The size of the table in the current * thread. */ diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 02ee038..7db5c19 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -62,7 +62,7 @@ static ThreadSpecificData *threadList = NULL; */ typedef struct ThreadCtrl { - const char *script; /* The Tcl command this thread should + const char *script; /* The Tcl command this thread should * execute */ int flags; /* Initial value of the "flags" field in the * ThreadSpecificData structure for the new @@ -229,8 +229,8 @@ ThreadObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0, - &option) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], threadOptions, + sizeof(char *), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } @@ -368,7 +368,7 @@ ThreadObjCmd( result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { - Tcl_SetIntObj(Tcl_GetObjResult(interp), status); + Tcl_SetLongObj(Tcl_GetObjResult(interp), status); } else { char buf[20]; @@ -415,7 +415,7 @@ ThreadObjCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_SetObjResult(interp, Tcl_NewLongObj( Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT))); return TCL_OK; } @@ -613,7 +613,7 @@ NewTestThread( */ Tcl_Preserve(tsdPtr->interp); - result = Tcl_Eval(tsdPtr->interp, threadEvalScript); + result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } @@ -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/tclTimer.c b/generic/tclTimer.c index c10986a..2d1cd33 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -91,7 +91,7 @@ typedef struct IdleHandler { * The structure defined below is used in this file only. */ -typedef struct ThreadSpecificData { +typedef struct { TimerHandler *firstTimerHandlerPtr; /* First event in queue. */ int lastTimerId; /* Timer identifier of most recently created * timer. */ @@ -823,8 +823,8 @@ Tcl_AfterObjCmd( || objv[1]->typePtr == &tclWideIntType #endif || objv[1]->typePtr == &tclBignumType - || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, - &index) != TCL_OK)) { + || (Tcl_GetIndexFromObjStruct(NULL, objv[1], afterSubCmds, + sizeof(char *), "", 0, &index) != TCL_OK)) { index = -1; if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) { const char *arg = Tcl_GetString(objv[1]); 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 69b095c..66b149a 100644..100755 --- 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 @@ -143,142 +132,142 @@ extern "C" { */ /* 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; @@ -495,7 +484,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/tclTrace.c b/generic/tclTrace.c index c0cde49..bbbbf3c 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -143,7 +143,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1, * trace procs */ -typedef struct StringTraceData { +typedef struct { ClientData clientData; /* Client data from Tcl_CreateTrace */ Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */ } StringTraceData; @@ -1849,7 +1849,7 @@ TraceExecutionProc( * Append result code. */ - resultCode = Tcl_NewIntObj(code); + resultCode = Tcl_NewLongObj(code); resultCodeStr = Tcl_GetString(resultCode); Tcl_DStringAppendElement(&cmd, resultCodeStr); Tcl_DecrRefCount(resultCode); @@ -1889,7 +1889,7 @@ TraceExecutionProc( * interpreter. */ - traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd)); + traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), -1, 0); tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS; /* @@ -1979,7 +1979,7 @@ TraceVarProc( int rewind = ((Interp *)interp)->execEnvPtr->rewind; /* - * We might call Tcl_Eval() below, and that might evaluate [trace vdelete] + * We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete] * which might try to free tvarPtr. We want to use tvarPtr until the end * of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure * it is not freed while we still need it. @@ -2801,39 +2801,6 @@ DisposeTraceResult( /* *---------------------------------------------------------------------- * - * Tcl_UntraceVar -- - * - * Remove a previously-created trace for a variable. - * - * Results: - * None. - * - * Side effects: - * If there exists a trace for the variable given by varName with the - * given flags, proc, and clientData, then that trace is removed. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_UntraceVar -void -Tcl_UntraceVar( - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits describing current - * trace, including any of TCL_TRACE_READS, - * TCL_TRACE_WRITES, TCL_TRACE_UNSETS, - * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_UntraceVar2 -- * * Remove a previously-created trace for a variable. @@ -2964,47 +2931,6 @@ Tcl_UntraceVar2( /* *---------------------------------------------------------------------- * - * Tcl_VarTraceInfo -- - * - * Return the clientData value associated with a trace on a variable. - * This function can also be used to step through all of the traces on a - * particular variable that have the same trace function. - * - * Results: - * The return value is the clientData value associated with a trace on - * the given variable. Information will only be returned for a trace with - * proc as trace function. If the clientData argument is NULL then the - * first such trace is returned; otherwise, the next relevant one after - * the one given by clientData will be returned. If the variable doesn't - * exist, or if there are no (more) traces for it, then NULL is returned. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_VarTraceInfo -ClientData -Tcl_VarTraceInfo( - Tcl_Interp *interp, /* Interpreter containing variable. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed combo or TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY (can be 0). */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ - ClientData prevClientData) /* If non-NULL, gives last value returned by - * this function, so this call will return the - * next trace after that one. If NULL, this - * call will return the first trace. */ -{ - return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, - prevClientData); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_VarTraceInfo2 -- * * Same as Tcl_VarTraceInfo, except takes name in two pieces instead of @@ -3075,45 +3001,6 @@ Tcl_VarTraceInfo2( /* *---------------------------------------------------------------------- * - * Tcl_TraceVar -- - * - * Arrange for reads and/or writes to a variable to cause a function to - * be invoked, which can monitor the operations and/or change their - * actions. - * - * Results: - * A standard Tcl return value. - * - * Side effects: - * A trace is set up on the variable given by varName, such that future - * references to the variable will be intermediated by proc. See the - * manual entry for complete details on the calling sequence for proc. - * The variable's flags are updated. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_TraceVar -int -Tcl_TraceVar( - Tcl_Interp *interp, /* Interpreter in which variable is to be - * traced. */ - const char *varName, /* Name of variable; may end with "(index)" to - * signify an array reference. */ - int flags, /* OR-ed collection of bits, including any of - * TCL_TRACE_READS, TCL_TRACE_WRITES, - * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and - * TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function to call when specified ops are - * invoked upon varName. */ - ClientData clientData) /* Arbitrary argument to pass to proc. */ -{ - return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_TraceVar2 -- * * Arrange for reads and/or writes to a variable to cause a function to diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 15529c7..48a56cd 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. */ @@ -986,7 +986,7 @@ int TclpUtfNcmp2( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numBytes) /* Number of *bytes* to compare. */ + size_t numBytes) /* Number of *bytes* to compare. */ { /* * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to @@ -1033,7 +1033,7 @@ int Tcl_UtfNcmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; @@ -1081,7 +1081,7 @@ int Tcl_UtfNcasecmp( const char *cs, /* UTF string to compare to ct. */ const char *ct, /* UTF string cs is compared to. */ - unsigned long numChars) /* Number of UTF chars to compare. */ + size_t numChars) /* Number of UTF chars to compare. */ { Tcl_UniChar ch1, ch2; while (numChars-- > 0) { @@ -1285,7 +1285,7 @@ int Tcl_UniCharNcmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { #ifdef WORDS_BIGENDIAN /* @@ -1330,7 +1330,7 @@ int Tcl_UniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - unsigned long numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { diff --git a/generic/tclUtil.c b/generic/tclUtil.c index b089132..7060b1d 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -871,9 +871,9 @@ Tcl_SplitList( int Tcl_ScanElement( - register const char *src, /* String to convert to list element. */ - register int *flagPtr) /* Where to store information to guide - * Tcl_ConvertCountedElement. */ + const char *src, /* String to convert to list element. */ + int *flagPtr) /* Where to store information to guide + * Tcl_ConvertCountedElement. */ { return Tcl_ScanCountedElement(src, -1, flagPtr); } @@ -908,7 +908,7 @@ Tcl_ScanCountedElement( int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { - int flags = CONVERT_ANY; + char flags = CONVERT_ANY; int numBytes = TclScanElement(src, length, &flags); *flagPtr = flags; @@ -949,7 +949,7 @@ int TclScanElement( const char *src, /* String to convert to Tcl list element. */ int length, /* Number of bytes in src, or -1. */ - int *flagPtr) /* Where to store information to guide + char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; @@ -1234,9 +1234,9 @@ TclScanElement( int Tcl_ConvertElement( - register const char *src, /* Source information for list element. */ - register char *dst, /* Place to put list-ified element. */ - register int flags) /* Flags produced by Tcl_ScanElement. */ + const char *src, /* Source information for list element. */ + char *dst, /* Place to put list-ified element. */ + int flags) /* Flags produced by Tcl_ScanElement. */ { return Tcl_ConvertCountedElement(src, -1, dst, flags); } @@ -1300,9 +1300,9 @@ TclConvertElement( register const char *src, /* Source information for list element. */ int length, /* Number of bytes in src, or -1. */ char *dst, /* Place to put list-ified element. */ - int flags) /* Flags produced by Tcl_ScanElement. */ + char flags) /* Flags produced by Tcl_ScanElement. */ { - int conversion = flags & CONVERT_MASK; + char conversion = flags & CONVERT_MASK; char *p = dst; /* @@ -1481,11 +1481,10 @@ Tcl_Merge( int argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { -#define LOCAL_SIZE 20 - int localFlags[LOCAL_SIZE], *flagPtr = NULL; +#define LOCAL_SIZE 64 + char localFlags[LOCAL_SIZE]; int i, bytesNeeded = 0; - char *result, *dst; - const int maxFlags = UINT_MAX / sizeof(int); + char *result, *dst, *flagPtr = NULL; /* * Handle empty list case first, so logic of the general case can be @@ -1504,22 +1503,8 @@ Tcl_Merge( if (argc <= LOCAL_SIZE) { flagPtr = localFlags; - } else if (argc > maxFlags) { - /* - * We cannot allocate a large enough flag array to format this list in - * one pass. We could imagine converting this routine to a multi-pass - * implementation, but for sizeof(int) == 4, the limit is a max of - * 2^30 list elements and since each element is at least one byte - * formatted, and requires one byte space between it and the next one, - * that a minimum space requirement of 2^31 bytes, which is already - * INT_MAX. If we tried to format a list of > maxFlags elements, we're - * just going to overflow the size limits on the formatted string - * anyway, so just issue that same panic early. - */ - - Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } else { - flagPtr = ckalloc(argc * sizeof(int)); + flagPtr = ckalloc(argc); } for (i = 0; i < argc; i++) { flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 ); @@ -1556,40 +1541,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 @@ -2631,7 +2582,7 @@ Tcl_DStringAppendElement( { char *dst = dsPtr->string + dsPtr->length; int needSpace = TclNeedSpace(dsPtr->string, dst); - int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; + char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0; int newSize = dsPtr->length + needSpace + TclScanElement(element, -1, &flags); @@ -2796,7 +2747,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 +2776,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); } /* @@ -3243,7 +3128,7 @@ TclPrecTraceProc( if (flags & TCL_TRACE_READS) { - Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr), + Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewLongObj(*precisionPtr), flags & TCL_GLOBAL_ONLY); return NULL; } @@ -3548,7 +3433,6 @@ TclGetIntForIndex( if (!strncmp(bytes, "end-", 4)) { bytes += 4; } - TclCheckBadOctal(interp, bytes); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL); } @@ -3692,73 +3576,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. @@ -4109,31 +3926,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 4694cd8..65439ea 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -846,9 +846,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 @@ -1228,49 +1225,6 @@ TclLookupArrayElement( /* *---------------------------------------------------------------------- * - * Tcl_GetVar -- - * - * Return the value of a Tcl variable as a string. - * - * Results: - * The return value points to the current value of varName as a string. - * If the variable is not defined or can't be read because of a clash in - * array usage then a NULL pointer is returned and an error message is - * left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set. - * Note: the return value is only valid up until the next change to the - * variable; if you depend on the value lasting longer than that, then - * make yourself a private copy. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_GetVar -const char * -Tcl_GetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - int flags) /* OR-ed combination of TCL_GLOBAL_ONLY, - * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG - * bits. */ -{ - Tcl_Obj *varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_Obj *resultPtr = Tcl_ObjGetVar2(interp, varNamePtr, NULL, flags); - - TclDecrRefCount(varNamePtr); - - if (resultPtr == NULL) { - return NULL; - } - return TclGetString(resultPtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_GetVar2 -- * * Return the value of a Tcl variable as a string, given a two-part name @@ -1569,55 +1523,6 @@ Tcl_SetObjCmd( /* *---------------------------------------------------------------------- * - * Tcl_SetVar -- - * - * Change the value of a variable. - * - * Results: - * Returns a pointer to the malloc'ed string which is the character - * representation of the variable's new value. The caller must not modify - * this string. If the write operation was disallowed then NULL is - * returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory - * message will be left in the interp's result. Note that the returned - * string may not be the same as newValue; this is because variable - * traces may modify the variable's value. - * - * Side effects: - * If varName is defined as a local or global variable in interp, its - * value is changed to newValue. If varName isn't currently defined, then - * a new global variable by that name is created. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_SetVar -const char * -Tcl_SetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. */ - const char *newValue, /* New value for varName. */ - int flags) /* Various flags that tell how to set value: - * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, - * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, - * TCL_LEAVE_ERR_MSG. */ -{ - Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1); - - Tcl_IncrRefCount(varNamePtr); - varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL, - Tcl_NewStringObj(newValue, -1), flags); - Tcl_DecrRefCount(varNamePtr); - - if (varValuePtr == NULL) { - return NULL; - } - return TclGetString(varValuePtr); -} - -/* - *---------------------------------------------------------------------- - * * Tcl_SetVar2 -- * * Given a two-part variable name, which may refer either to a scalar @@ -2141,12 +2046,12 @@ TclPtrIncrObjVar( VarHashRefCount(varPtr)--; } if (varValuePtr == NULL) { - varValuePtr = Tcl_NewIntObj(0); + varValuePtr = Tcl_NewLongObj(0); } if (Tcl_IsShared(varValuePtr)) { /* Copy on write */ varValuePtr = Tcl_DuplicateObj(varValuePtr); - + if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) { return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, varValuePtr, flags, index); @@ -2176,55 +2081,6 @@ TclPtrIncrObjVar( /* *---------------------------------------------------------------------- * - * Tcl_UnsetVar -- - * - * Delete a variable, so that it may not be accessed anymore. - * - * Results: - * Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if - * the variable can't be unset. In the event of an error, if the - * TCL_LEAVE_ERR_MSG flag is set then an error message is left in the - * interp's result. - * - * Side effects: - * If varName is defined as a local or global variable in interp, it is - * deleted. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_UnsetVar -int -Tcl_UnsetVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *varName, /* Name of a variable in interp. May be either - * a scalar name or an array name or an - * element in an array. */ - int flags) /* OR-ed combination of any of - * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or - * TCL_LEAVE_ERR_MSG. */ -{ - int result; - Tcl_Obj *varNamePtr; - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - - /* - * Filter to pass through only the flags this interface supports. - */ - - flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG); - result = TclObjUnsetVar2(interp, varNamePtr, NULL, flags); - - Tcl_DecrRefCount(varNamePtr); - return result; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_UnsetVar2 -- * * Delete a variable, given a 2-part name. @@ -3770,8 +3626,8 @@ ArrayNamesCmd( * Finish parsing the arguments. */ - if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option", - 0, &mode) != TCL_OK) { + if ((objc == 4) && Tcl_GetIndexFromObjStruct(interp, objv[2], options, + sizeof(char *), "option", 0, &mode) != TCL_OK) { return TCL_ERROR; } @@ -4030,7 +3886,7 @@ ArraySizeCmd( } } - Tcl_SetObjResult(interp, Tcl_NewIntObj(size)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(size)); return TCL_OK; } @@ -4460,7 +4316,7 @@ TclPtrMakeUpvar( } /* Callers must Incr myNamePtr if they plan to Decr it. */ - + int TclPtrObjMakeUpvar( Tcl_Interp *interp, /* Interpreter containing variables. Used for @@ -4582,61 +4438,6 @@ TclPtrObjMakeUpvar( /* *---------------------------------------------------------------------- * - * Tcl_UpVar -- - * - * This function links one variable to another, just like the "upvar" - * command. - * - * Results: - * A standard Tcl completion code. If an error occurs then an error - * message is left in the interp's result. - * - * Side effects: - * The variable in frameName whose name is given by varName becomes - * accessible under the name localNameStr, so that references to - * localNameStr are redirected to the other variable like a symbolic - * link. - * - *---------------------------------------------------------------------- - */ - -#undef Tcl_UpVar -int -Tcl_UpVar( - Tcl_Interp *interp, /* Command interpreter in which varName is to - * be looked up. */ - const char *frameName, /* Name of the frame containing the source - * variable, such as "1" or "#0". */ - const char *varName, /* Name of a variable in interp to link to. - * May be either a scalar name or an element - * in an array. */ - const char *localNameStr, /* Name of link variable. */ - int flags) /* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY: - * indicates scope of localNameStr. */ -{ - int result; - CallFrame *framePtr; - Tcl_Obj *varNamePtr, *localNamePtr; - - if (TclGetFrame(interp, frameName, &framePtr) == -1) { - return TCL_ERROR; - } - - varNamePtr = Tcl_NewStringObj(varName, -1); - Tcl_IncrRefCount(varNamePtr); - localNamePtr = Tcl_NewStringObj(localNameStr, -1); - Tcl_IncrRefCount(localNamePtr); - - result = ObjMakeUpvar(interp, framePtr, varNamePtr, NULL, 0, - localNamePtr, flags, -1); - Tcl_DecrRefCount(varNamePtr); - Tcl_DecrRefCount(localNamePtr); - return result; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_UpVar2 -- * * This function links one variable to another, just like the "upvar" diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 9bceb4c..48be8b0 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -371,7 +371,7 @@ ConvertErrorToList( default: TclNewLiteralStringObj(objv[2], "UNKNOWN"); - TclNewIntObj(objv[3], code); + TclNewLongObj(objv[3], code); return Tcl_NewListObj(4, objv); } } @@ -545,7 +545,7 @@ ExtractHeader( &tmp); SetValue(dictObj, "comment", TclDStringToObj(&tmp)); } - SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); + SetValue(dictObj, "crc", Tcl_NewLongObj(headerPtr->hcrc!=0)); if (headerPtr->name != Z_NULL) { if (latin1enc == NULL) { /* @@ -563,7 +563,7 @@ ExtractHeader( SetValue(dictObj, "filename", TclDStringToObj(&tmp)); } if (headerPtr->os != 255) { - SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os)); + SetValue(dictObj, "os", Tcl_NewLongObj(headerPtr->os)); } if (headerPtr->time != 0 /* magic - no time */) { SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time)); @@ -763,7 +763,7 @@ Tcl_ZlibStreamInit( */ if (interp != NULL) { - if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) { + if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); @@ -2581,7 +2581,7 @@ ZlibStreamCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream))); + Tcl_SetObjResult(interp, Tcl_NewLongObj(Tcl_ZlibStreamEof(zstream))); return TCL_OK; case zs_checksum: /* $strm checksum */ if (objc != 2) { @@ -3847,7 +3847,7 @@ TclZlibInit( * commands. */ - Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}"); + Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0); /* * Create the public scripted interface to this file's functionality. @@ -3871,7 +3871,7 @@ TclZlibInit( * Formally provide the package as a Tcl built-in. */ - return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); + return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL); } /* diff --git a/library/http/http.tcl b/library/http/http.tcl index a6b2bfd..160342f 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.8 diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 27ba795..4a03a53 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.8 [list tclPkgSetup $dir http 2.8.8 {{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 1ca6413..c9db41c 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -16,7 +16,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.6.1 +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 cf3b9d7..e10f094 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.2 diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 5fabfe3..75b32e6 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.2 [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 52daa0e..a94bfaa 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 60a9485..b253f34 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.6 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index c30d2e4..f59e25b 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/library/tm.tcl b/library/tm.tcl index 55efda6..fefcfd9 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -337,6 +337,18 @@ proc ::tcl::tm::Defaults {} { } } } + if {$major == 8} return + for {set n 7} {$n >= 0} {incr n -1} { + foreach ev [::list \ + TCL8.${n}_TM_PATH \ + TCL8_${n}_TM_PATH \ + ] { + if {![info exists env($ev)]} continue + foreach p [split $env($ev) $sep] { + path add $p + } + } + } return } @@ -354,7 +366,7 @@ proc ::tcl::tm::Defaults {} { # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - lassign [split [package present Tcl] .] major minor + regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { @@ -365,6 +377,16 @@ proc ::tcl::tm::roots {paths} { set px [file join $p site-tcl] if {![interp issafe]} {set px [file normalize $px]} path add $px + if {$major == 8} continue + set p [file join $pa tcl8] + for {set n 7} {$n >= 0} {incr n -1} { + set px [file join $p 8.${n}] + if {![interp issafe]} {set px [file normalize $px]} + path add $px + } + set px [file join $p site-tcl] + if {![interp issafe]} {set px [file normalize $px]} + path add $px } return } 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/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index a2a703b..7fb918e 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -15,7 +15,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; @@ -209,7 +208,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; }; F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; }; F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; }; - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; }; F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; }; F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; }; F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; }; @@ -1289,7 +1287,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, @@ -2023,7 +2020,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 9c18ac0..ddd5e3b 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -15,7 +15,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; }; F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; }; F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; }; - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; }; F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; }; F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; }; F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; }; @@ -209,7 +208,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; }; F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; }; F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; }; - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; }; F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; }; F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; }; F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; }; @@ -1289,7 +1287,6 @@ F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */, F93599C10DF1F78300E04F67 /* tclOOMethod.c */, F93599C30DF1F78800E04F67 /* tclOOStubInit.c */, - F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */, F96D3F0E08F272A7004A47F5 /* tclPanic.c */, F96D3F0F08F272A7004A47F5 /* tclParse.c */, F96D3F1108F272A7004A47F5 /* tclPathObj.c */, @@ -2023,7 +2020,6 @@ F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */, F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */, F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */, - F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */, F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */, F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */, F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */, diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c index 8ecfd0b..d16f33f 100644 --- a/macosx/tclMacOSXFCmd.c +++ b/macosx/tclMacOSXFCmd.c @@ -192,7 +192,7 @@ TclMacOSXGetFileAttribute( OSSwapBigToHostInt32(finder->type)); break; case MACOSX_HIDDEN_ATTRIBUTE: - *attributePtrPtr = Tcl_NewBooleanObj( + *attributePtrPtr = Tcl_NewLongObj( (finder->fdFlags & kFinfoIsInvisible) != 0); break; case MACOSX_RSRCLENGTH_ATTRIBUTE: diff --git a/pkgs/README b/pkgs/README index 868bd4f..01c6f43 100644 --- a/pkgs/README +++ b/pkgs/README @@ -39,7 +39,7 @@ needs to conform to the following conventions. distclean: Delete all generated files. dist: Produce a copy of the package's source code distribution. - Must respect the DIST_ROOT variable determining where to + Must respect the DIST_ROOT variable determing where to write the generated directory. Packages that are written to make use of the Tcl Extension Architecture (TEA) 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 b0487e6..d424c86 100644 --- a/tests/assemble.test +++ b/tests/assemble.test @@ -781,7 +781,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 { 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 39e9ece..68a9a49 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 36e24de..d46faef 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 06a00ba..7d6e6f8 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -24,12 +24,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 {} { @@ -197,34 +191,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. @@ -265,46 +259,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"}} @@ -493,7 +487,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 * @@ -507,10 +501,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 * @@ -534,7 +528,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 * @@ -847,12 +841,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} @@ -952,10 +940,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 @@ -963,7 +947,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} @@ -1003,11 +987,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} @@ -1015,7 +999,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 8f27ad4..b99dd16 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 351fd4f..c22d83b 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 050b592..a0b88dd 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.5 +package require Tcl 8.5- 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 714c45b..9e2af18 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -1043,9 +1043,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/reg.test b/tests/reg.test index e6ce42c..5cc81fe 100644 --- a/tests/reg.test +++ b/tests/reg.test @@ -513,7 +513,7 @@ expectMatch 9.40 eE {a[\\]b} "a\\b" "a\\b" expectMatch 9.41 bE {a[\\]b} "a\\b" "a\\b" expectError 9.42 - {a[\Z]b} EESCAPE expectMatch 9.43 & {a[[b]c} "a\[c" "a\[c" -expectMatch 9.44 EMP* {a[\u00fe-\u0507][\u00ff-\u0300]b} \ +expectMatch 9.44 M* "a\[\u00fe-\u0507\]\[\u00ff-\u0300\]b" \ "a\u0102\u02ffb" "a\u0102\u02ffb" @@ -624,25 +624,19 @@ expectMatch 13.12 P "a\\fb" "a\fb" "a\fb" expectMatch 13.13 P "a\\nb" "a\nb" "a\nb" expectMatch 13.14 P "a\\rb" "a\rb" "a\rb" expectMatch 13.15 P "a\\tb" "a\tb" "a\tb" -expectMatch 13.16 P "a\\u0008x" "a\bx" "a\bx" -expectMatch 13.17 P {a\u008x} "a\bx" "a\bx" -expectMatch 13.18 P "a\\u00088x" "a\b8x" "a\b8x" -expectMatch 13.19 P "a\\U00000008x" "a\bx" "a\bx" -expectMatch 13.20 P {a\U0000008x} "a\bx" "a\bx" +expectMatch 13.16 - "a\u0008x" "a\bx" "a\bx" +expectMatch 13.19 - "a\U00000008x" "a\bx" "a\bx" +expectMatch 13.20 - "a\U0000008x" "a\bx" "a\bx" expectMatch 13.21 P "a\\vb" "a\vb" "a\vb" expectMatch 13.22 MP "a\\x08x" "a\bx" "a\bx" expectError 13.23 - {a\xq} EESCAPE expectMatch 13.24 MP "a\\x08x" "a\bx" "a\bx" expectError 13.25 - {a\z} EESCAPE expectMatch 13.26 MP "a\\010b" "a\bb" "a\bb" -expectMatch 13.27 P "a\\U00001234x" "a\u1234x" "a\u1234x" -expectMatch 13.28 P {a\U00001234x} "a\u1234x" "a\u1234x" -expectMatch 13.29 P "a\\U0001234x" "a\u1234x" "a\u1234x" -expectMatch 13.30 P {a\U0001234x} "a\u1234x" "a\u1234x" -expectMatch 13.31 P "a\\U000012345x" "a\u12345x" "a\u12345x" -expectMatch 13.32 P {a\U000012345x} "a\u12345x" "a\u12345x" -expectMatch 13.33 P "a\\U1000000x" "a\ufffd0x" "a\ufffd0x" -expectMatch 13.34 P {a\U1000000x} "a\ufffd0x" "a\ufffd0x" +expectMatch 13.27 - "a\U00001234x" "a\u1234x" "a\u1234x" +expectMatch 13.29 - "a\U0001234x" "a\u1234x" "a\u1234x" +expectMatch 13.31 - "a\U000012345x" "a\u12345x" "a\u12345x" +expectMatch 13.33 - "a\U1000000x" "a\ufffd0x" "a\ufffd0x" doing 14 "back references" diff --git a/tests/safe.test b/tests/safe.test index 859f352..d41708b 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 740cdc6..1b0486c 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 1b22f8c..280b058 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::* @@ -202,6 +202,11 @@ proc genpaths {base} { set base [file normalize $base] lassign [split [package present Tcl] .] major minor set results {} + set base8 [file join $base tcl8] + lappend results [file join $base8 site-tcl] + for {set i 0} {$i <= 7} {incr i} { + lappend results [file join $base8 8.$i] + } set base [file join $base tcl$major] lappend results [file join $base site-tcl] for {set i 0} {$i <= $minor} {incr i} { 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 b45e560..c12568b 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 -- 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 89e8e5c..c0e1c1d 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/tools/tsdPerf.c b/tools/tsdPerf.c index 40004b1..e1ac552 100644 --- a/tools/tsdPerf.c +++ b/tools/tsdPerf.c @@ -33,7 +33,7 @@ tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); - Tcl_SetObjResult(interp, Tcl_NewIntObj(perf->value)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(perf->value)); return TCL_OK; } diff --git a/unix/Makefile.in b/unix/Makefile.in index 6c09473..80718ae 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -139,8 +139,8 @@ TCL_STUB_LIB_FLAG = @TCL_STUB_LIB_FLAG@ # To compile without backward compatibility and deprecated code uncomment the # following -NO_DEPRECATED_FLAGS = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +#NO_DEPRECATED_FLAGS = +NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # Some versions of make, like SGI's, use the following variable to determine # which shell to use for executing commands: @@ -337,7 +337,6 @@ TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \ STUB_LIB_OBJS = tclStubLib.o \ tclTomMathStubLib.o \ - tclOOStubLib.o \ ${COMPAT_OBJS} UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \ @@ -475,8 +474,7 @@ OO_SRCS = \ STUB_SRCS = \ $(GENERIC_DIR)/tclStubLib.c \ - $(GENERIC_DIR)/tclTomMathStubLib.c \ - $(GENERIC_DIR)/tclOOStubLib.c + $(GENERIC_DIR)/tclTomMathStubLib.c TOMMATH_SRCS = \ $(TOMMATH_DIR)/bncore.c \ @@ -1695,9 +1693,6 @@ tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c -tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c - $(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclOOStubLib.c - .c.o: $(CC) -c $(CC_SWITCHES) $< diff --git a/unix/configure b/unix/configure index 06ff7a4..e96afb9 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=".1" +TCL_VERSION=9.0 +TCL_MAJOR_VERSION=9 +TCL_MINOR_VERSION=0 +TCL_PATCH_LEVEL="a0" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -6780,7 +6780,7 @@ fi if test "$GCC" = yes; then CFLAGS_OPTIMIZE=-O2 - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wwrite-strings" else @@ -19740,7 +19740,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 @@ -19798,7 +19798,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 61ad30f..e2daccd 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=".1" +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..d21ef95 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: */ @@ -71,7 +62,7 @@ Pkga_EqObjCmd( } else { result = 0; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; } @@ -124,17 +115,17 @@ Pkga_QuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkga_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkga", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkga", "1.0", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c index f102496..3629027 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" /* @@ -66,7 +65,7 @@ Pkgb_SubObjCmd( Tcl_AppendResult(interp, " in line: ", buf, NULL); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second)); return TCL_OK; } diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c index 557f21b..a1d9ba0 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: */ @@ -65,7 +56,7 @@ Pkgc_SubObjCmd( || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second)); return TCL_OK; } @@ -114,17 +105,17 @@ Pkgc_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } @@ -151,17 +142,17 @@ Pkgc_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgc_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2"); + code = Tcl_PkgProvideEx(interp, "Pkgc", "1.7.2", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c index 6e114e9..3718dfb 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: */ @@ -65,7 +56,7 @@ Pkgd_SubObjCmd( || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(first - second)); return TCL_OK; } @@ -114,17 +105,17 @@ Pkgd_UnsafeObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } @@ -151,17 +142,17 @@ Pkgd_Init( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgd_SafeInit( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { int code; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - code = Tcl_PkgProvide(interp, "Pkgd", "7.3"); + code = Tcl_PkgProvideEx(interp, "Pkgd", "7.3", NULL); if (code != TCL_OK) { return code; } diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c index d616352..c3380a7 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,15 +31,15 @@ *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkge_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ { static const char script[] = "if 44 {open non_existent}"; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } - return Tcl_Eval(interp, script); + return Tcl_EvalEx(interp, script, -1, 0); } diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c index 78af376..a715fbc 100644 --- a/unix/dltest/pkgooa.c +++ b/unix/dltest/pkgooa.c @@ -78,7 +78,7 @@ static TclOOStubs stubsCopy = { (Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *, const char *t)) Pkgooa_StubsOKObjCmd /* More entries could be here, but those are not used - * for this test-case. So, being NULL is OK. */ + * needed for this test-case. So, being NULL is OK. */ }; extern DLLEXPORT int @@ -88,15 +88,7 @@ Pkgooa_Init( { int code; - /* Any TclOO extension which uses stubs, calls - * both Tcl_InitStubs and Tcl_OOInitStubs() and - * does not use any Tcl 8.6 features should be - * loadable in Tcl 8.5 as well, provided the - * TclOO extension (for Tcl 8.5) is installed. - * This worked in Tcl 8.6.0, and is expected - * to keep working in all future Tcl 8.x releases. - */ - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } if (tclStubsPtr == NULL) { diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 417bedb..a320bce 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: */ @@ -147,7 +138,7 @@ PkguaEqObjCmd( } else { result = 0; } - Tcl_SetObjResult(interp, Tcl_NewIntObj(result)); + Tcl_SetObjResult(interp, Tcl_NewLongObj(result)); return TCL_OK; } @@ -200,7 +191,7 @@ PkguaQuoteObjCmd( *---------------------------------------------------------------------- */ -EXTERN int +DLLEXPORT int Pkgua_Init( Tcl_Interp *interp) /* Interpreter in which the package is to be * made available. */ @@ -208,7 +199,7 @@ Pkgua_Init( int code, cmdIndex = 0; Tcl_Command *cmdTokens; - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + if (Tcl_InitStubs(interp, "9.0", 0) == NULL) { return TCL_ERROR; } @@ -219,7 +210,7 @@ Pkgua_Init( PkguaInitTokensHashTable(); - code = Tcl_PkgProvide(interp, "Pkgua", "1.0"); + code = Tcl_PkgProvideEx(interp, "Pkgua", "1.0", NULL); if (code != TCL_OK) { return code; } @@ -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.m4 b/unix/tcl.m4 index 194cf90..71f4f97 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1115,7 +1115,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g AS_IF([test "$GCC" = yes], [ CFLAGS_OPTIMIZE=-O2 - CFLAGS_WARNING="-Wall" + CFLAGS_WARNING="-Wall -Wwrite-strings" ], [ CFLAGS_OPTIMIZE=-O CFLAGS_WARNING="" diff --git a/unix/tcl.spec b/unix/tcl.spec index 678222c..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.1 +Version: 9.0a0 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index e55dcd0..23d6026 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -115,9 +115,6 @@ /* Define to 1 if you have the `gmtime_r' function. */ #undef HAVE_GMTIME_R -/* Compiler support for module scope symbols */ -#undef HAVE_HIDDEN - /* Do we have the intptr_t type? */ #undef HAVE_INTPTR_T @@ -346,6 +343,9 @@ /* Do we have <values.h>? */ #undef NO_VALUES_H +/* Compiler support for module scope symbols */ +#undef HAVE_HIDDEN + /* Do we have wait3() */ #undef NO_WAIT3 diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index fdc9d1d..9b4d690 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -61,7 +61,7 @@ * This structure describes per-instance state of a file based channel. */ -typedef struct FileState { +typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ int fd; /* File handle. */ int validMask; /* OR'ed combination of TCL_READABLE, @@ -76,7 +76,7 @@ typedef struct FileState { * a platform-independant manner. */ -typedef struct TtyAttrs { +typedef struct { int baud; int parity; int data; diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 2a68f7f..e5929ba 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -8,8 +8,6 @@ */ #include "tclInt.h" -#include <pwd.h> -#include <grp.h> #include <errno.h> #include <string.h> @@ -49,7 +47,7 @@ #ifdef TCL_THREADS -typedef struct ThreadSpecificData { +typedef struct { struct passwd pwd; #if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5) #define NEED_PW_CLEANER 1 diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index e270b6a..5b993f4 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -41,8 +41,6 @@ */ #include "tclInt.h" -#include <utime.h> -#include <grp.h> #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> @@ -1340,7 +1338,7 @@ GetGroupAttribute( groupPtr = TclpGetGrGid(statBuf.st_gid); if (groupPtr == NULL) { - *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); + *attributePtrPtr = Tcl_NewLongObj((long) statBuf.st_gid); } else { Tcl_DString ds; const char *utf; @@ -1394,7 +1392,7 @@ GetOwnerAttribute( pwPtr = TclpGetPwUid(statBuf.st_uid); if (pwPtr == NULL) { - *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); + *attributePtrPtr = Tcl_NewLongObj((long) statBuf.st_uid); } else { Tcl_DString ds; @@ -2285,7 +2283,7 @@ GetReadOnlyAttribute( return TCL_ERROR; } - *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE); + *attributePtrPtr = Tcl_NewLongObj((statBuf.st_flags&UF_IMMUTABLE)!=0); return TCL_OK; } diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index f07b123..39be160 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -42,12 +42,12 @@ static const char *const platforms[NUMPLATFORMS] = { }; #define NUMPROCESSORS 11 -static const char *const processors[NUMPROCESSORS] = { +static const char *const processors[NUMPROCESSORS] = { "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil", "amd64", "ia32_on_win64" }; -typedef struct _SYSTEM_INFO { +typedef struct { union { DWORD dwOemId; struct { @@ -66,7 +66,7 @@ typedef struct _SYSTEM_INFO { int wProcessorRevision; } SYSTEM_INFO; -typedef struct _OSVERSIONINFOA { +typedef struct { DWORD dwOSVersionInfoSize; DWORD dwMajorVersion; DWORD dwMinorVersion; @@ -112,7 +112,7 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; * first list checked for a mapping from env encoding to Tcl encoding name. */ -typedef struct LocaleTable { +typedef struct { const char *lang; const char *encoding; } LocaleTable; diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index b234667..043735a 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -39,7 +39,7 @@ typedef struct FileHandler { * handlers are ready to fire. */ -typedef struct FileHandlerEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ int fd; /* File descriptor that is ready. Used to find @@ -54,7 +54,7 @@ typedef struct FileHandlerEvent { * writable, and exception conditions. */ -typedef struct SelectMasks { +typedef struct { fd_set readable; fd_set writable; fd_set exception; diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 9c21b28..ac9ba77 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -30,7 +30,7 @@ * This structure describes per-instance state of a pipe based channel. */ -typedef struct PipeState { +typedef struct { Tcl_Channel channel; /* Channel associated with this file. */ TclFile inFile; /* Output from pipe. */ TclFile outFile; /* Input to pipe. */ @@ -870,7 +870,7 @@ TclGetAndDetachPids( pipePtr = Tcl_GetChannelInstanceData(chan); TclNewObj(pidsObj); for (i = 0; i < pipePtr->numPids; i++) { - Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj( + Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewLongObj( PTR2INT(pipePtr->pidPtr[i]))); Tcl_DetachPids(1, &pipePtr->pidPtr[i]); } @@ -1288,7 +1288,7 @@ Tcl_PidObjCmd( resultPtr = Tcl_NewObj(); for (i = 0; i < pipePtr->numPids; i++) { Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); + Tcl_NewLongObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i])))); } Tcl_SetObjResult(interp, resultPtr); } diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 4b0f369..31a0719 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -37,7 +37,7 @@ * exercised by the "testfilehandler" command. */ -typedef struct Pipe { +typedef struct { TclFile readFile; /* File handle for reading from the pipe. NULL * means pipe doesn't exist yet. */ TclFile writeFile; /* File handle for writing from the pipe. */ @@ -68,10 +68,10 @@ static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; static Tcl_ObjCmdProc TestforkObjCmd; -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); @@ -108,9 +108,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); @@ -517,16 +517,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; } @@ -596,15 +602,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/tclUnixThrd.c b/unix/tclUnixThrd.c index f469341..c943b77 100644 --- a/unix/tclUnixThrd.c +++ b/unix/tclUnixThrd.c @@ -15,12 +15,6 @@ #ifdef TCL_THREADS -typedef struct ThreadSpecificData { - char nabuf[16]; -} ThreadSpecificData; - -static Tcl_ThreadDataKey dataKey; - /* * masterLock is used to serialize creation of mutexes, condition variables, * and thread local storage. This is the only place that can count on the @@ -631,50 +625,6 @@ TclpFinalizeCondition( } #endif /* TCL_THREADS */ -/* - *---------------------------------------------------------------------- - * - * TclpReaddir, TclpInetNtoa -- - * - * These procedures replace core C versions to be used in a threaded - * environment. - * - * Results: - * See documentation of C functions. - * - * Side effects: - * See documentation of C functions. - * - * Notes: - * TclpReaddir is no longer used by the core (see 1095909), but it - * appears in the internal stubs table (see #589526). - * - *---------------------------------------------------------------------- - */ - -Tcl_DirEntry * -TclpReaddir( - DIR * dir) -{ - return TclOSreaddir(dir); -} - -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ -#ifdef TCL_THREADS - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - unsigned char *b = (unsigned char*) &addr.s_addr; - - sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]); - return tsdPtr->nabuf; -#else - return inet_ntoa(addr); -#endif -} - #ifdef TCL_THREADS /* * Additions by AOL for specialized thread memory allocator. @@ -684,7 +634,7 @@ TclpInetNtoa( static volatile int initialized = 0; static pthread_key_t key; -typedef struct allocMutex { +typedef struct { Tcl_Mutex tlock; pthread_mutex_t plock; } allocMutex; @@ -692,10 +642,10 @@ typedef struct allocMutex { Tcl_Mutex * TclpNewAllocMutex(void) { - struct allocMutex *lockPtr; + allocMutex *lockPtr; register pthread_mutex_t *plockPtr; - lockPtr = malloc(sizeof(struct allocMutex)); + lockPtr = malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 926e8f4..27b6a58 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -16,38 +16,10 @@ #include <mach/mach_time.h> #endif -#define TM_YEAR_BASE 1900 -#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. - */ - -TCL_DECLARE_MUTEX(tmMutex) - -static char *lastTZ = NULL; /* Holds the last setting of the TZ - * environment variable, or an empty string if - * the variable was not set. */ - /* * Static functions declared in this file. */ -static void SetTZIfNecessary(void); -static void CleanupMemory(ClientData clientData); static void NativeScaleTime(Tcl_Time *timebuf, ClientData clientData); static void NativeGetTime(Tcl_Time *timebuf, @@ -251,114 +223,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 @@ -470,70 +334,6 @@ NativeGetTime( timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } -/* - *---------------------------------------------------------------------- - * - * SetTZIfNecessary -- - * - * Determines whether a call to 'tzset' is needed prior to the next call - * to 'localtime' or examination of the 'timezone' variable. - * - * Results: - * None. - * - * Side effects: - * If 'tzset' has never been called in the current process, or if the - * value of the environment variable TZ has changed since the last call - * to 'tzset', then 'tzset' is called again. - * - *---------------------------------------------------------------------- - */ - -static void -SetTZIfNecessary(void) -{ - const char *newTZ = getenv("TZ"); - - Tcl_MutexLock(&tmMutex); - if (newTZ == NULL) { - newTZ = ""; - } - if (lastTZ == NULL || strcmp(lastTZ, newTZ)) { - tzset(); - if (lastTZ == NULL) { - Tcl_CreateExitHandler(CleanupMemory, NULL); - } else { - ckfree(lastTZ); - } - lastTZ = ckalloc(strlen(newTZ) + 1); - strcpy(lastTZ, newTZ); - } - Tcl_MutexUnlock(&tmMutex); -} - -/* - *---------------------------------------------------------------------- - * - * CleanupMemory -- - * - * Releases the private copy of the TZ environment variable upon exit - * from Tcl. - * - * Results: - * None. - * - * Side effects: - * Frees allocated memory. - * - *---------------------------------------------------------------------- - */ - -static void -CleanupMemory( - ClientData ignored) -{ - ckfree(lastTZ); -} /* * Local Variables: diff --git a/win/Makefile.in b/win/Makefile.in index bc1205a..0051c8b 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -84,8 +84,8 @@ CFLAGS = @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE # To compile without backward compatibility and deprecated code uncomment the # following -NO_DEPRECATED_FLAGS = -#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED +#NO_DEPRECATED_FLAGS = +NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED # To enable compilation debugging reverse the comment characters on one of the # following lines. @@ -385,8 +385,7 @@ REG_OBJS = tclWinReg.$(OBJEXT) STUB_OBJS = \ tclStubLib.$(OBJEXT) \ - tclTomMathStubLib.$(OBJEXT) \ - tclOOStubLib.$(OBJEXT) + tclTomMathStubLib.$(OBJEXT) TCLSH_OBJS = tclAppInit.$(OBJEXT) @@ -518,9 +517,6 @@ tclStubLib.${OBJEXT}: tclStubLib.c tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) -tclOOStubLib.${OBJEXT}: tclOOStubLib.c - $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME) - # Implicit rule for all object files that will end up in the Tcl library %.${OBJEXT}: %.c @@ -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 d614ad5..10e1b4a 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=".1" +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 @@ -3646,7 +3646,7 @@ echo "$as_me: error: ${CC} does not support the -shared option. CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= diff --git a/win/configure.in b/win/configure.in index 4cc1e9f..419a9b8 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=".1" +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 a962bc6..73fbc19 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 @@ -279,8 +279,7 @@ TCLOBJS = \ TCLSTUBOBJS = \ $(TMPDIR)\tclStubLib.obj \ - $(TMPDIR)\tclTomMathStubLib.obj \ - $(TMPDIR)\tclOOStubLib.obj + $(TMPDIR)\tclTomMathStubLib.obj WINDIR = $(ROOT)\win GENERICDIR = $(ROOT)\generic @@ -531,9 +530,6 @@ $(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c $(TMPDIR)\tclTomMathStubLib.obj : $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? -$(TMPDIR)\tclOOStubLib.obj : $(GENERICDIR)\tclOOStubLib.c - $(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $? - # Dedependency rules diff --git a/win/makefile.vc b/win/makefile.vc index b76a939..e3851c9 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -450,8 +450,7 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS) TCLSTUBOBJS = \ $(TMP_DIR)\tclStubLib.obj \ - $(TMP_DIR)\tclTomMathStubLib.obj \ - $(TMP_DIR)\tclOOStubLib.obj + $(TMP_DIR)\tclTomMathStubLib.obj ### The following paths CANNOT have spaces in them. COMPATDIR = $(ROOT)\compat @@ -982,9 +981,6 @@ $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? -$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c - $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? - #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a diff --git a/win/tcl.dsp b/win/tcl.dsp index 57ec6bf..96152b8 100644 --- a/win/tcl.dsp +++ b/win/tcl.dsp @@ -1300,10 +1300,6 @@ SOURCE=..\generic\tclStubLib.c # End Source File # Begin Source File -SOURCE=..\generic\tclOOStubLib.c -# End Source File -# Begin Source File - SOURCE=..\generic\tclTomMathStubLib.c # End Source File # Begin Source File @@ -727,7 +727,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CFLAGS_DEBUG=-g CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer" - CFLAGS_WARNING="-Wall -Wdeclaration-after-statement" + CFLAGS_WARNING="-Wall -Wwrite-strings -Wdeclaration-after-statement" LDFLAGS_DEBUG= LDFLAGS_OPTIMIZE= @@ -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/tclWinChan.c b/win/tclWinChan.c index 21115f7..29717e0 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -43,7 +43,7 @@ typedef struct FileInfo { * pending on the channel. */ } FileInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * List of all file channels currently open. */ @@ -58,7 +58,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct FileEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ FileInfo *infoPtr; /* Pointer to file info structure. Note that diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 65e4aed..a2d0e40 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -49,7 +49,7 @@ TCL_DECLARE_MUTEX(consoleMutex) * threads. */ -typedef struct ConsoleThreadInfo { +typedef struct { HANDLE thread; /* Handle to reader or writer thread. */ HANDLE readyEvent; /* Manual-reset event to signal _to_ the main * thread when the worker thread has finished @@ -112,7 +112,7 @@ typedef struct ConsoleInfo { /* Data consumed by reader thread. */ } ConsoleInfo; -typedef struct ThreadSpecificData { +typedef struct{ /* * The following pointer refers to the head of the list of consoles that * are being watched for file events. @@ -128,7 +128,7 @@ static Tcl_ThreadDataKey dataKey; * console events are generated. */ -typedef struct ConsoleEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ ConsoleInfo *infoPtr; /* Pointer to console info structure. Note diff --git a/win/tclWinDde.c b/win/tclWinDde.c index ce0b413..3f953ce 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -34,16 +34,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. */ @@ -69,7 +59,7 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; -typedef struct DdeEnumServices { +typedef struct { Tcl_Interp *interp; int result; ATOM service; @@ -77,7 +67,7 @@ typedef struct DdeEnumServices { HWND hwnd; } DdeEnumServices; -typedef struct ThreadSpecificData { +typedef struct { Conversation *currentConversations; /* A list of conversations currently being * processed. */ @@ -114,7 +104,7 @@ TCL_DECLARE_MUTEX(ddeMutex) static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); -static int DdeCreateClient(struct DdeEnumServices *es); +static int DdeCreateClient(DdeEnumServices *es); static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam); static void DdeExitProc(ClientData clientData); @@ -135,8 +125,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); /* *---------------------------------------------------------------------- @@ -158,20 +148,13 @@ int Dde_Init( Tcl_Interp *interp) { - if (!Tcl_InitStubs(interp, "8.1", 0)) { + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } -#ifdef UNICODE - if (TclWinGetPlatformId() < VER_PLATFORM_WIN32_NT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "Win32s and Windows 9x are not supported platforms", -1)); - return TCL_ERROR; - } -#endif Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL); Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); + return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL); } /* @@ -397,9 +380,12 @@ DdeSetServerName( for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; Tcl_DString ds; + const char *nameStr; + int len; Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); - Tcl_WinUtfToTChar(Tcl_GetString(namePtr), -1, &ds); + nameStr = Tcl_GetStringFromObj(namePtr, &len); + Tcl_WinUtfToTChar(nameStr, len, &ds); if (_tcscmp(actualName, (TCHAR *)Tcl_DStringValue(&ds)) == 0) { suffix++; Tcl_DStringFree(&ds); @@ -584,18 +570,26 @@ ExecuteRemoteObject( returnPackagePtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, returnPackagePtr, - Tcl_NewIntObj(result)); + Tcl_NewLongObj(result)); Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_GetObjResult(riPtr->interp)); if (result == TCL_ERROR) { - Tcl_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL, + Tcl_Obj *errorObjPtr; + Tcl_Obj *varName = Tcl_NewStringObj("errorCode", -1); + + Tcl_IncrRefCount(varName); + errorObjPtr = Tcl_ObjGetVar2(riPtr->interp, varName, NULL, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(varName); if (errorObjPtr) { Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); } - errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL, + varName = Tcl_NewStringObj("errorInfo", -1); + Tcl_IncrRefCount(varName); + errorObjPtr = Tcl_ObjGetVar2(riPtr->interp, varName, NULL, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(varName); if (errorObjPtr) { Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); } @@ -758,7 +752,7 @@ DdeServerProc( } else { returnString = (char *) Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len); - len = sizeof(TCHAR) * len + 1; + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0); @@ -768,10 +762,15 @@ DdeServerProc( } else { Tcl_DString ds; Tcl_Obj *variableObjPtr; + Tcl_Obj *varName; + Tcl_WinTCharToUtf(utilString, -1, &ds); - variableObjPtr = Tcl_GetVar2Ex( - convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, + varName = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(varName); + variableObjPtr = Tcl_ObjGetVar2( + convPtr->riPtr->interp, varName, NULL, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(varName); if (variableObjPtr != NULL) { if (uFmt == CF_TEXT) { returnString = Tcl_GetStringFromObj( @@ -779,7 +778,7 @@ DdeServerProc( } else { returnString = (char *) Tcl_GetUnicodeFromObj( variableObjPtr, &len); - len = sizeof(TCHAR) * len + 1; + len = 2 * len + 1; } ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString, (DWORD) len+1, 0, ddeItem, @@ -816,6 +815,7 @@ DdeServerProc( if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) { Tcl_DString ds; Tcl_Obj *variableObjPtr; + Tcl_Obj *varName; len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE); Tcl_DStringInit(&dString); @@ -831,9 +831,11 @@ DdeServerProc( variableObjPtr = Tcl_NewUnicodeObj(utilString, -1); } - Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL, + varName = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + Tcl_IncrRefCount(varName); + Tcl_ObjSetVar2(convPtr->riPtr->interp, varName, NULL, variableObjPtr, TCL_GLOBAL_ONLY); - + Tcl_DecrRefCount(varName); Tcl_DStringFree(&ds); Tcl_DStringFree(&dString); ddeReturn = (HDDEDATA) DDE_FACK; @@ -1040,7 +1042,7 @@ MakeDdeConnection( static int DdeCreateClient( - struct DdeEnumServices *es) + DdeEnumServices *es) { WNDCLASSEX wc; static const TCHAR *szDdeClientClassName = TEXT("TclEval client class"); @@ -1050,7 +1052,7 @@ DdeCreateClient( wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; - wc.cbWndExtra = sizeof(struct DdeEnumServices *); + wc.cbWndExtra = sizeof(DdeEnumServices *); /* * Register and create the callback window. @@ -1072,8 +1074,8 @@ DdeClientWindowProc( switch (uMsg) { case WM_CREATE: { LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; - struct DdeEnumServices *es = - (struct DdeEnumServices *) lpcs->lpCreateParams; + DdeEnumServices *es = + (DdeEnumServices *) lpcs->lpCreateParams; #ifdef _WIN64 SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es); @@ -1098,14 +1100,14 @@ DdeServicesOnAck( HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); - struct DdeEnumServices *es; + DdeEnumServices *es; TCHAR sz[255]; Tcl_DString dString; #ifdef _WIN64 - es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); + es = (DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)0 || es->service == service) @@ -1156,7 +1158,7 @@ DdeEnumWindowsCallback( LPARAM lParam) { DWORD_PTR dwResult = 0; - struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; + DdeEnumServices *es = (DdeEnumServices *) lParam; SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, @@ -1170,7 +1172,7 @@ DdeGetServicesList( const TCHAR *serviceName, const TCHAR *topicName) { - struct DdeEnumServices es; + DdeEnumServices es; es.interp = interp; es.result = TCL_OK; @@ -1310,16 +1312,16 @@ DdeObjCmd( return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], ddeCommands, + sizeof(char *), "command", 0, &index) != TCL_OK) { return TCL_ERROR; } switch ((enum DdeSubcommands) index) { case DDE_SERVERNAME: for (i = 2; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, - "option", 0, &argIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeSrvOptions, + sizeof(char *), "option", 0, &argIndex) != TCL_OK) { /* * If it is the last argument, it might be a server name * instead of a bad argument. @@ -1367,8 +1369,8 @@ DdeObjCmd( } else if (objc >= 6 && objc <= 7) { firstArg = objc - 3; for (i = 2; i < firstArg; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions, - "option", 0, &argIndex) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[i], ddeExecOptions, + sizeof(char *), "option", 0, &argIndex) != TCL_OK) { goto wrongDdeExecuteArgs; } if (argIndex == DDE_EXEC_ASYNC) { @@ -1388,8 +1390,8 @@ DdeObjCmd( if (objc == 6) { firstArg = 2; break; - } else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + } else if ((objc == 7) && (Tcl_GetIndexFromObjStruct(NULL, objv[2], + ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; @@ -1406,8 +1408,8 @@ DdeObjCmd( if (objc == 5) { firstArg = 2; break; - } else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2], - ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) { + } else if ((objc == 6) && (Tcl_GetIndexFromObjStruct(NULL, objv[2], + ddeReqOptions, sizeof(char *), "option", 0, &argIndex) == TCL_OK)) { flags |= DDE_FLAG_BINARY; firstArg = 3; break; @@ -1434,8 +1436,8 @@ DdeObjCmd( return TCL_ERROR; } else { firstArg = 2; - if (Tcl_GetIndexFromObj(NULL, objv[2], ddeEvalOptions, "option", - 0, &argIndex) == TCL_OK) { + if (Tcl_GetIndexFromObjStruct(NULL, objv[2], ddeEvalOptions, + sizeof(char *), "option", 0, &argIndex) == TCL_OK) { if (objc < 5) { goto wrongDdeEvalArgs; } @@ -1748,21 +1750,26 @@ DdeObjCmd( } if (interp != sendInterp) { if (result == TCL_ERROR) { + Tcl_Obj *varName; /* * An error occurred, so transfer error information from * the destination interpreter back to our interpreter. */ Tcl_ResetResult(interp); - objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, + varName = Tcl_NewStringObj("errorInfo", -1); + Tcl_IncrRefCount(varName); + objPtr = Tcl_ObjGetVar2(sendInterp, varName, NULL, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(varName); if (objPtr) { - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); } - - objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, + varName = Tcl_NewStringObj("errorCode", -1); + Tcl_IncrRefCount(varName); + objPtr = Tcl_ObjGetVar2(sendInterp, varName, NULL, TCL_GLOBAL_ONLY); + Tcl_DecrRefCount(varName); if (objPtr) { Tcl_SetObjErrorCode(interp, objPtr); } @@ -1853,9 +1860,7 @@ DdeObjCmd( Tcl_DecrRefCount(resultPtr); goto invalidServerResponse; } - length = -1; - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); + Tcl_AppendObjToErrorInfo(interp, objPtr); Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 2700cb3..042fe67 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -1545,7 +1545,7 @@ GetWinFileAttributes( } } - *attributePtrPtr = Tcl_NewBooleanObj(attr); + *attributePtrPtr = Tcl_NewLongObj(attr!=0); return TCL_OK; } diff --git a/win/tclWinInt.h b/win/tclWinInt.h index c7066bb..87ccb1b 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -32,6 +32,20 @@ typedef struct TCLEXCEPTION_REGISTRATION { #endif /* + * 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/tclWinNotify.c b/win/tclWinNotify.c index 4543b02..aaa5878 100644 --- a/win/tclWinNotify.c +++ b/win/tclWinNotify.c @@ -27,7 +27,7 @@ * created for each thread that is using the notifier. */ -typedef struct ThreadSpecificData { +typedef struct { CRITICAL_SECTION crit; /* Monitor for this notifier. */ DWORD thread; /* Identifier for thread associated with this * notifier. */ diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 13caba9..88497d2 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -50,7 +50,7 @@ TCL_DECLARE_MUTEX(pipeMutex) * used in a pipeline. */ -typedef struct WinFile { +typedef struct { int type; /* One of the file types defined above. */ HANDLE handle; /* Open file handle. */ } WinFile; @@ -142,7 +142,7 @@ typedef struct PipeInfo { * synchronized with the readable object. */ } PipeInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * The following pointer refers to the head of the list of pipes that are * being watched for file events. @@ -158,7 +158,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct PipeEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ PipeInfo *infoPtr; /* Pointer to pipe info structure. Note that diff --git a/win/tclWinPort.h b/win/tclWinPort.h index 61f149b..c418b3b 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -467,8 +467,6 @@ typedef DWORD_PTR * PDWORD_PTR; * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0) */ #if defined(_MSC_VER) && (_MSC_VER >= 1400) -# pragma warning(disable:4244) -# pragma warning(disable:4267) # pragma warning(disable:4996) #endif diff --git a/win/tclWinReg.c b/win/tclWinReg.c index 327e4a3..372096e 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); /* *---------------------------------------------------------------------- @@ -172,7 +163,7 @@ Registry_Init( cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, interp, DeleteCmd); Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); - return Tcl_PkgProvide(interp, "registry", "1.3.0"); + return Tcl_PkgProvideEx(interp, "registry", "1.3.0", NULL); } /* @@ -290,9 +281,9 @@ RegistryObjCmd( return TCL_ERROR; } - if (Tcl_GetString(objv[n])[0] == '-') { - if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, - &index) != TCL_OK) { + if (Tcl_GetStringFromObj(objv[n], NULL)[0] == '-') { + if (Tcl_GetIndexFromObjStruct(interp, objv[n++], modes, + sizeof(char *), "mode", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { @@ -308,8 +299,8 @@ RegistryObjCmd( } } - if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, - &index) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[n++], subcommands, + sizeof(char *), "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -529,7 +520,8 @@ DeleteValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to delete value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(valueNameObj, NULL), + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); result = TCL_ERROR; } else { @@ -577,7 +569,7 @@ GetKeyNames( Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ if (patternObj) { - pattern = Tcl_GetString(patternObj); + pattern = Tcl_GetStringFromObj(patternObj, NULL); } else { pattern = NULL; } @@ -606,7 +598,7 @@ GetKeyNames( } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to enumerate subkeys of \"%s\": ", - Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); result = TCL_ERROR; } @@ -689,7 +681,8 @@ GetType( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get type of value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(valueNameObj, NULL), + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); return TCL_ERROR; } @@ -700,7 +693,7 @@ GetType( */ if (type > lastType) { - Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type)); + Tcl_SetObjResult(interp, Tcl_NewLongObj((int) type)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1)); } @@ -783,7 +776,8 @@ GetValue( if (result != ERROR_SUCCESS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unable to get value \"%s\" from key \"%s\": ", - Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); + Tcl_GetStringFromObj(valueNameObj, NULL), + Tcl_GetStringFromObj(keyNameObj, NULL))); AppendSystemError(interp, result); Tcl_DStringFree(&data); return TCL_ERROR; @@ -797,7 +791,7 @@ GetValue( */ if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { - Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, + Tcl_SetObjResult(interp, Tcl_NewLongObj((long) ConvertDWORD(type, *((DWORD *) Tcl_DStringValue(&data))))); } else if (type == REG_MULTI_SZ) { char *p = Tcl_DStringValue(&data); @@ -887,7 +881,7 @@ GetValueNames( result = TCL_OK; if (patternObj) { - pattern = Tcl_GetString(patternObj); + pattern = Tcl_GetStringFromObj(patternObj, NULL); } else { pattern = NULL; } @@ -1127,8 +1121,8 @@ ParseKeyName( */ rootObj = Tcl_NewStringObj(rootName, -1); - result = Tcl_GetIndexFromObj(interp, rootObj, rootKeyNames, "root name", - TCL_EXACT, &index); + result = Tcl_GetIndexFromObjStruct(interp, rootObj, rootKeyNames, + sizeof(char *), "root name", TCL_EXACT, &index); Tcl_DecrRefCount(rootObj); if (result != TCL_OK) { return TCL_ERROR; @@ -1263,8 +1257,8 @@ SetValue( if (typeObj == NULL) { type = REG_SZ; - } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", - 0, (int *) &type) != TCL_OK) { + } else if (Tcl_GetIndexFromObjStruct(interp, typeObj, typeNames, + sizeof(char *), "type", 0, (int *) &type) != TCL_OK) { if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { return TCL_ERROR; } @@ -1417,7 +1411,7 @@ BroadcastValue( * Use the ignore the result. */ - result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE, + result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); objPtr = Tcl_NewObj(); diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 75d5ffc..9961b01 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -120,7 +120,7 @@ typedef struct SerialInfo { * [fconfigure -queue] */ } SerialInfo; -typedef struct ThreadSpecificData { +typedef struct { /* * The following pointer refers to the head of the list of serials that * are being watched for file events. @@ -136,7 +136,7 @@ static Tcl_ThreadDataKey dataKey; * events are generated. */ -typedef struct SerialEvent { +typedef struct { Tcl_Event header; /* Information that is standard for all * events. */ SerialInfo *infoPtr; /* Pointer to serial info structure. Note that diff --git a/win/tclWinSock.c b/win/tclWinSock.c index f4d5a90..798c8cd 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -2736,24 +2736,6 @@ TclWinSetSockOpt( return setsockopt(s, level, optname, optval, optlen); } -#undef TclpInetNtoa -char * -TclpInetNtoa( - struct in_addr addr) -{ - /* - * Check that WinSock is initialized; do not call it if not, to prevent - * system crashes. This can happen at exit time if the exit handler for - * WinSock ran before other exit handlers that want to use sockets. - */ - - if (!SocketsEnabled()) { - return NULL; - } - - return inet_ntoa(addr); -} - struct servent * TclWinGetServByName( const char *name, diff --git a/win/tclWinTest.c b/win/tclWinTest.c index b83c0ba..17b76b8 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -277,11 +277,11 @@ TestwinclockCmd( result = Tcl_NewObj(); Tcl_ListObjAppendElement(interp, result, - Tcl_NewIntObj((int) (t2.QuadPart / 10000000))); + Tcl_NewLongObj((int) (t2.QuadPart / 10000000))); Tcl_ListObjAppendElement(interp, result, - Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000))); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec)); - Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec)); + Tcl_NewLongObj((int) ((t2.QuadPart / 10) % 1000000))); + Tcl_ListObjAppendElement(interp, result, Tcl_NewLongObj(tclTime.sec)); + Tcl_ListObjAppendElement(interp, result, Tcl_NewLongObj(tclTime.usec)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart)); @@ -368,8 +368,8 @@ TestExceptionCmd( Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0, - &cmd) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, objv[1], cmds, + sizeof(char *), "command", 0, &cmd) != TCL_OK) { return TCL_ERROR; } diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index 1c9d483..6c4ed7f 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -13,8 +13,6 @@ #include "tclWinInt.h" -#include <float.h> - /* Workaround for mingw versions which don't provide this in float.h */ #ifndef _MCW_EM # define _MCW_EM 0x0008001F /* Error masks */ @@ -110,7 +108,7 @@ static Tcl_ThreadDataKey dataKey; * the queue. */ -typedef struct WinCondition { +typedef struct { CRITICAL_SECTION condLock; /* Lock to serialize queuing on the * condition. */ struct ThreadSpecificData *firstPtr; /* Queue pointers */ @@ -125,7 +123,7 @@ typedef struct WinCondition { static int once; static DWORD tlsKey; -typedef struct allocMutex { +typedef struct { Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; @@ -947,9 +945,9 @@ TclpFinalizeCondition( Tcl_Mutex * TclpNewAllocMutex(void) { - struct allocMutex *lockPtr; + allocMutex *lockPtr; - lockPtr = malloc(sizeof(struct allocMutex)); + lockPtr = malloc(sizeof(allocMutex)); if (lockPtr == NULL) { Tcl_Panic("could not allocate lock"); } diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 7045c72..0762362 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,29 +19,10 @@ #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. */ -typedef struct TimeInfo { +typedef struct { CRITICAL_SECTION cs; /* Mutex guarding this structure. */ int initialized; /* Flag == 1 if this structure is * initialized. */ @@ -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. |