diff --git a/ChangeLog b/ChangeLog index 61e3e04c3bc9..b1890869ce26 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1382,7 +1382,7 @@ a better first place to look now. 2012-05-03 Jan Nijtmans - * compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5, + * compat/zlib/*: Upgrade to zlib 1.2.7 (prebuilt dll is still 1.2.5, will be upgraded as soon as the official build is available) 2012-05-03 Don Porter @@ -5482,7 +5482,7 @@ a better first place to look now. * generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput, (ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption, (ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve - ReflectedChannel* structures across handler invokations, to avoid + ReflectedChannel* structures across handler invocations, to avoid crashes when the handler implementation induces nested callbacks and destruction of the channel deep inside such a nesting. @@ -6363,7 +6363,7 @@ a better first place to look now. 2009-12-28 Donal K. Fellows * unix/Makefile.in (trace-shell, trace-test): [FRQ 1083288]: Added - targets to allow easier tracing of shell and test invokations. + targets to allow easier tracing of shell and test invocations. * unix/configure.in: [Bug 942170]: Detect the st_blocks field of * generic/tclCmdAH.c (StoreStatData): 'struct stat' correctly. @@ -6847,7 +6847,7 @@ a better first place to look now. * unix/tclUnixChan.c (TtyParseMode): Partial undo of Donal's tidy-up from a few days ago (2009-11-9, not in ChangeLog). It seems that - strchr is apparently a macro on AIX and reacts badly to pre-processor + strchr is apparently a macro on AIX and reacts badly to preprocessor directives in its arguments. 2009-11-16 Alexandre Ferrieux @@ -7141,7 +7141,7 @@ a better first place to look now. package-* that were for building Solaris packages. Appears that the pieces needed for these targets to function have never been present in the current era of Tcl development and belong completely to Tcl - pre-history. + prehistory. 2009-10-19 Don Porter @@ -8709,7 +8709,7 @@ a better first place to look now. 2009-01-19 David Gravereaux * win/build.vc.bat: Improved tools detection and error message - * win/makefile.vc: Reorganized the $(TCLOBJ) file list into seperate + * win/makefile.vc: Reorganized the $(TCLOBJ) file list into separate parts for easier maintenance. Matched all sources built using -GL to both $(lib) and $(link) to use -LTCG and avoid a warning message. Addressed the over-building nature of the htmlhelp target by moving diff --git a/ChangeLog.1999 b/ChangeLog.1999 index 3bf4e9aecbae..e736dee68d1d 100644 --- a/ChangeLog.1999 +++ b/ChangeLog.1999 @@ -388,7 +388,7 @@ the beginning of the test run * tests/basic.test: Use version information defined in tcltest instead - of hardcoded version number + of hard-coded version number * tests/socket.test: package require tcltest before attempting to use variable defined in tcltest namespace diff --git a/ChangeLog.2000 b/ChangeLog.2000 index 8abe6c21a380..ee2b629c5a55 100644 --- a/ChangeLog.2000 +++ b/ChangeLog.2000 @@ -103,7 +103,7 @@ 119398] * library/init.tcl (unknown): Added specific level parameters to - all uplevel invokations to boost performance; didn't dare touch + all uplevel invocation to boost performance; didn't dare touch the "namespace inscope" stuff though, since it looks sensitive to me! Should fix [Bug 123217], though testing is tricky... @@ -348,7 +348,7 @@ makeFile/makeDirectory and removeFile/removeDirectory. * tests/basic.test: Changed references to tcltest::tclVersion to - hardcoded numbers. + hard-coded numbers. * generic/tcl.h: Changed reference to tcltest2.tcl and tcltest.tcl in comments to tests/basic.test. @@ -1121,7 +1121,7 @@ 2000-06-27 Eric Melski - * tests/stringObj.test: Tweaked tests to avoid hardcoded high-ASCII + * tests/stringObj.test: Tweaked tests to avoid hard-coded high-ASCII characters (which will fail in multibyte locales); instead used \uXXXX syntax. [Bug: 3842]. @@ -1546,7 +1546,7 @@ * unix/mkLinks: Regen'd with new mkLinks.tcl. * unix/mkLinks.tcl: Fixed indentation, made link setup more - intelligent (only do one existance test per man page, instead of one + intelligent (only do one existence test per man page, instead of one per function). * doc/library.n: Fixed .SH NAME macro to include each function @@ -1641,7 +1641,7 @@ 2000-04-21 Brent Welch * library/http2.1/http.tcl: More thrashing with the "server closes - without reading post data" scenario. Reverted to the previous filevent + without reading post data" scenario. Reverted to the previous fileevent configuratiuon, which seems to work better with small amounts of post data. @@ -2267,7 +2267,7 @@ * library/auto.tcl: Fixed the regular expression that performs $ escaping before sourcing a file to index. It was erroneously adding \ escapes even to $'s that were already escaped, effectively - "un-escaping" those $'s. (bug #2611). + "unescaping" those $'s. (bug #2611). 2000-01-27 Eric Melski @@ -2378,7 +2378,7 @@ * generic/tclVar.c: Changed behavior of variable command when name refers to an element in an array (ie, "variable foo(x)") to always - return an error, regardless of existance of that element in the array + return an error, regardless of existence of that element in the array (now behavior is consistant with docs too) (bug #981). 2000-01-20 Jeff Hobbs diff --git a/ChangeLog.2002 b/ChangeLog.2002 index fa31e427bdfd..953447688dec 100644 --- a/ChangeLog.2002 +++ b/ChangeLog.2002 @@ -15,7 +15,7 @@ * tests/winPipe.test: * win/tclWinPipe.c (Tcl_WaitPid): * win/tclWinTest.c: Gave Tcl_WaitPid the ability to return a Win32 - exception code translated into a posix style SIG*. This allows [close] + exception code translated into a Posix-style SIG*. This allows [close] to report "CHILDKILLED" without the meaning getting lost in a truncated exit code. In TclCleanupChildren(), TclpGetPid() had to get moved to before Tcl_WaitPid() as the the handle is removed from the @@ -1941,7 +1941,7 @@ * tests/pkg/samename.tcl: restored. needed by pkgMkIndex.test. - * library/tcltest/tcltest.tcl: restored writeability testing of + * library/tcltest/tcltest.tcl: restored writability testing of -tmpdir, augmented by a special exception for the deafault value. 2002-07-01 Donal K. Fellows @@ -1959,9 +1959,9 @@ * tests/info.test: [temporaryDirectory] of tcltest. * tests/interp.test: - * library/tcltest/tcltest.tcl: Stopped checking for writeability of + * library/tcltest/tcltest.tcl: Stopped checking for writability of -tmpdir value because no default directory can be guaranteed to be - writeable. + writable. * tests/autoMkindex.tcl: removed. * tests/pkg/samename.tcl: removed. @@ -2469,7 +2469,7 @@ thread-safe *_r counterparts are not available. * unix/tcl.m4: added configure check for readdir_r * unix/tcl.m4 (Darwin): set TCL_DEFAULT_ENCODING to utf-8 on MacOSX - (where posix file apis expect utf-8, not iso8859-1). + (where Posix file apis expect utf-8, not iso8859-1). * unix/configure: regen * unix/Makefile.in: set DYLD_LIBRARY_PATH in parallel to LD_LIBRARY_PATH for MacOSX dynamic linker. @@ -3683,7 +3683,7 @@ * win/tclAppInit.c: Changed #include "tcl.h" to be tclPort.h to remove the raw windows.h include. tclPort.h brings in windows.h already and - lessens the pre-compiled-header mush and the randomly useless #pragma + lessens the precompiled-header mush and the randomly useless #pragma comment (lib,...) references throughout the big windows.h tree (as observed at high linker warning levels). @@ -3793,7 +3793,7 @@ * generic/tclIO.c: Large-file support (with many consequences.) * compat/strtoll.c, compat/strtoull.c: New support functions. * unix/tcl.m4, unix/configure: 64-bit support and greatly enhanced - cacheing. + caching. Most other changes, including all those in doc/* and test/* as well as the majority in the platform directories, follow on from these. diff --git a/ChangeLog.2003 b/ChangeLog.2003 index 3c3ee116ef43..d0f4ebcbc8fe 100644 --- a/ChangeLog.2003 +++ b/ChangeLog.2003 @@ -268,7 +268,7 @@ recently fixed by 2003-11-15 commit to regcomp.c by Pavel Goran. His notes on the fix: This bug results from an error in code that splits states into "progress" and "no-progress" ones. This error causes an - interesting situation with the pre-collected single-linked list of + interesting situation with the precollected single-linked list of states to be splitted: many items were added to the list, but only several of them are accessible from the list beginning, since the "tmp" member of struct state (which is used here to hold a pointer to @@ -2331,7 +2331,7 @@ argument, the Tcl_Interp struct loses its termOffset field and the TCL_BRACKET_TERM flag in the evalFlags field, all of which were only used (indirectly) by Tcl_SubstObj(). Tests subst-8.7,8.8,11.4,11.5 - modified to accomodate the only behavior change: reporting of parse + modified to accommodate the only behavior change: reporting of parse errors now takes precedence over [return] and [continue] exceptions. All other behavior should remain compatible. [RFE 536831,684982] [Bug 685106] @@ -2571,7 +2571,7 @@ 2003-02-25 Don Porter * doc/pkgMkIndex.n: Modified [pkg_mkIndex] to use -nocase matching - * library/package.tcl: of -load patterns, to better accomodate common + * library/package.tcl: of -load patterns, to better accommodate common user errors due to confusion between [package names] names and [info loaded] names. diff --git a/ChangeLog.2004 b/ChangeLog.2004 index 550e286a0aae..e2373826629c 100644 --- a/ChangeLog.2004 +++ b/ChangeLog.2004 @@ -377,7 +377,7 @@ strstr, strtoul and strtod. * unix/tcl.m4 (SC_TCL_CHECK_BROKEN_FUNC): Split a complex stanza out of configure.in into its own function. Also force it to do the right - thing with cacheing of results of AC_TRY_RUN to deal with issue raised + thing with caching of results of AC_TRY_RUN to deal with issue raised in [Patch 1073524] * doc/foreach.n: Added simple example. [FRQ 1073334] @@ -1975,7 +1975,7 @@ * doc/FileSystem.3: * generic/tclIOUtil.c: Clarified documentation regarding ability of a filesystem to say that it doesn't support a given operation using the - EXDEV posix error code (copyFileProc, renameFileProc, etc), and + EXDEV Posix error code (copyFileProc, renameFileProc, etc), and updated one piece of code to ensure correct behaviour when an operation is not supported [Bug 1017072] @@ -2277,7 +2277,7 @@ with vfs [Bug 991420]. * tests/fileSystem.test: added test for above bug. - * doc/FileSystem.3: clarified documentation of posix error codes in + * doc/FileSystem.3: clarified documentation of Posix error codes in 'remove directory' FS proc - 'EEXIST' is used to signify a non-empty directory error (bug reported against tclvfs). @@ -4339,7 +4339,7 @@ provided by the c-runtime. [Bug 672938] * win/nmakehlp.c: defensive techniques to avoid static buffer - overflows and a couple envars upsetting invokations of cl.exe and + overflows and a couple envars upsetting invocations of cl.exe and link.exe. [Bug 885537] * tests/winPipe.test: Added proof that BuildCommandLine() is not doing @@ -4548,7 +4548,7 @@ dictionary is computed at compile time (when it is fully known). The dictionary is pushed on the stack along with the result, and the code and level values are included in the bytecode as operands. Also - supports optimized compilation of un-[catch]ed [return]s from procs + supports optimized compilation of un[catch]ed [return]s from procs with default options into the INST_DONE instruction. * generic/tclExecute.c: Rewrote INST_RETURN instruction to retrieve diff --git a/ChangeLog.2005 b/ChangeLog.2005 index 109ea8e9acbe..f2d1b65b4fb4 100644 --- a/ChangeLog.2005 +++ b/ChangeLog.2005 @@ -229,7 +229,7 @@ ***POTENTIAL INCOMPATIBILITY*** for bytecode savers/loaders. See below * generic/tclCompCmds.c (TclCompileSwitchCmd): Arrange for very simple - [switch] invokations to be compiled into hash lookups into jump tables; + [switch] invocations to be compiled into hash lookups into jump tables; only a very specific kind of [switch] can be safely compiled this way, but that happens to be the most common kind. This makes around 5-10% difference to the speed of execution of clock.test. diff --git a/ChangeLog.2007 b/ChangeLog.2007 index b01db6ac852d..404bc4de52ee 100644 --- a/ChangeLog.2007 +++ b/ChangeLog.2007 @@ -1426,7 +1426,7 @@ initialization assumptions of the TIP 280 code in CompileWord(). * generic/tclCompExpr.c: Suppress the attempt to convert to - numeric when pre-compiling a constant expression indicates an error. + numeric when precompiling a constant expression indicates an error. 2007-08-22 Miguel Sofer @@ -2827,8 +2827,8 @@ 2007-03-24 Zoran Vasiljevic * win/tclWinThrd.c: Thread exit handler marks the current thread as - un-initialized. This allows exit handlers that are registered later to - re-initialize this subsystem in case they need to use some sync + uninitialized. This allows exit handlers that are registered later to + reinitialize this subsystem in case they need to use some sync primitives (cond variables) from this file again. 2007-03-23 Miguel Sofer @@ -4938,7 +4938,7 @@ Misc patches to make code more efficient. [Bug 1530474] (afredd) * generic/*.c, macosx/tclMacOSXNotify.c, unix/tclUnixNotfy.c, - * win/tclWinThrd.c: Tidy up invokations of Tcl_Panic() to promote + * win/tclWinThrd.c: Tidy up invocations of Tcl_Panic() to promote string constant sharing and consistent style. * generic/tclBasic.c (Tcl_CreateInterp): More efficient handling of * generic/tclClock.c (TclClockInit): registration of commands not @@ -5016,7 +5016,7 @@ 2006-07-24 Don Porter - * win/tclWinSock.c: Correct un-initialized Tcl_DString. Thanks to + * win/tclWinSock.c: Correct uninitialized Tcl_DString. Thanks to afredd. [Bug 1518166] 2006-07-21 Miguel Sofer diff --git a/ChangeLog.2008 b/ChangeLog.2008 index 53690e49c11d..7df6cbcdcc57 100644 --- a/ChangeLog.2008 +++ b/ChangeLog.2008 @@ -1207,7 +1207,7 @@ * generic/tcl.decls, doc/Ensemble.3, doc/namespace.n * tests/namespace.test: Allow the handling of a (fixed) number of formal parameters between an ensemble's command and subcommand at - invokation time. [Patch 1901783] + invocation time. [Patch 1901783] 2008-09-28 Miguel Sofer @@ -3252,7 +3252,7 @@ 2008-03-21 Donal K. Fellows * doc/switch.n: Clarified documentation in respect of two-argument - invokation. [Bug 1899962] + invocation. [Bug 1899962] * tests/switch.test: Added more tests of regexp-mode compilation of the [switch] command. [Bug 1854435] diff --git a/changes b/changes index 6fbf5187014a..d47432e641ec 100644 --- a/changes +++ b/changes @@ -2486,7 +2486,7 @@ interpreter. (JL) installing and requesting security policies, purely in Tcl code. Overloads the package command to also allow an interpreter to "require" a policy. The following new library commands are provided: - tcl_safeCreateInterp -- creates a slave an initializes the + tcl_safeCreateInterp -- creates a slave and initializes the policy mechanism. tcl_safeInitInterp -- initializes an existing slave with the policy mechanism. @@ -3028,7 +3028,7 @@ in case of errors is required for proper cleanup by the user of fcopy. (BW) x eval rename foo blotz x alias foo {} The problem was that the interp code was not using the actual current name -of the command to be deleted as a result of un-aliasing foo. (JL) +of the command to be deleted as a result of unaliasing foo. (JL) 6/19/97 (feature change) Pass interp down to the ChannelOption and driver specific calls so system errors can be differentiated from syntax @@ -4167,7 +4167,7 @@ Only.) This fix included: the location of the encoding files and libraries. This fix included: - Adding the TclSetPerInitScript routine. - Modifying the Tcl_Init routines to evaluate the non-NULL - pre-init script. + preinit script. - Adding the Tcl_SetdefaultEncodingDir and Tcl_GetDefaultEncodingDir routines. - Modifying the TclpInitLibrary routines to append the default @@ -6977,7 +6977,7 @@ of traced command do not fire (sofer) 2007-08-16 (bug fix)[1773040] ::errorInfo trace crash (janssen,porter) -2007-08-16 (performance)[1564517] pre-compile constant expressions (porter) +2007-08-16 (performance)[1564517] precompile constant expressions (porter) 2007-08-21 (bug fix)[1775878] 'puts \' in interactive tclsh failed to move to prompt for continuation line (porter) @@ -8685,7 +8685,7 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich) 2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni) -2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni) +2016-07-09 [ae61a6] [file] handling of Win hard-coded names (CON) (nadkarni) *** POTENTIAL INCOMPATIBILITY *** 2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni) diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c index e03e2b1e8da6..0f0112b42d63 100644 --- a/compat/zlib/contrib/minizip/minizip.c +++ b/compat/zlib/contrib/minizip/minizip.c @@ -66,6 +66,9 @@ #ifdef _WIN32 #define USEWIN32IOAPI #include "iowin32.h" +# if defined(_MSC_VER) +# define snprintf _snprintf +# endif #endif @@ -365,7 +368,7 @@ void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, i void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) { tinydir_dir dir; int i; - char newname[512]; + char newname[MAXFILENAME+1+MAXFILENAME+1]; tinydir_open_sorted(&dir, filenameinzip); @@ -375,7 +378,7 @@ void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, i tinydir_readfile_n(&dir, &file, i); if(strcmp(file.name,".")==0) continue; if(strcmp(file.name,"..")==0) continue; - sprintf(newname,"%s/%s",dir.path,file.name); + snprintf(newname, sizeof(newname), "%.*s/%.*s", MAXFILENAME, dir.path, MAXFILENAME, file.name); if (file.is_dir) { addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level); diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index 3968820e9d9e..1b3a84884f02 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -54,30 +54,27 @@ For \fBTcl_AddObjErrorInfo\fR, this points to the first byte of an array of \fIlength\fR bytes containing a string to append to the \fB\-errorinfo\fR return option. This byte array may contain embedded null bytes -unless \fIlength\fR is TCL_INDEX_NONE. +unless \fIlength\fR is negative. .AP Tcl_Obj *objPtr in A message to be appended to the \fB\-errorinfo\fR return option in the form of a Tcl_Obj value. -.AP size_t length in +.AP Tcl_Size length in The number of bytes to copy from \fImessage\fR when appending to the \fB\-errorinfo\fR return option. -If TCL_INDEX_NONE, all bytes up to the first null byte are used. +If negative, all bytes up to the first null byte are used. .AP Tcl_Obj *errorObjPtr in The \fB\-errorcode\fR return option will be set to this value. .AP "const char" *element in String to record as one element of the \fB\-errorcode\fR return option. Last \fIelement\fR argument must be NULL. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. .AP int lineNum The line number of a script where an error occurred. .AP "const char" *script in Pointer to first character in script containing command (must be <= command) .AP "const char" *command in Pointer to first character in command that generated the error -.AP size_t commandLength in -Number of bytes in command; TCL_INDEX_NONE means use all bytes up to first null byte +.AP Tcl_Size commandLength in +Number of bytes in command; a negative value means use all bytes up to first null byte .BE .SH DESCRIPTION .PP @@ -227,7 +224,7 @@ embedded null bytes. This is essentially never a good idea. If the \fImessage\fR needs to contain the null character \fBU+0000\fR, Tcl's usual internal encoding rules should be used to avoid the need for a null byte. If the \fBTcl_AddObjErrorInfo\fR -interface is used at all, it should be with a TCL_INDEX_NONE \fIlength\fR value. +interface is used at all, it should be with a negative \fIlength\fR value. .PP The procedure \fBTcl_SetObjErrorCode\fR is used to set the \fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index 69f55d63e50c..32e042f68bb9 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -34,7 +34,7 @@ unsigned char * .AP "const unsigned char" *bytes in The array of bytes used to initialize or set a byte-array value. May be NULL even if \fInumBytes\fR is non-zero. -.AP size_t numBytes in +.AP Tcl_Size numBytes in The number of bytes in the array. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be @@ -43,7 +43,7 @@ overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR, to the value from which to extract an array of bytes. .AP Tcl_Interp *interp in Interpreter to use for error reporting. -.AP "size_t \&| int" *numBytesPtr out +.AP "Tcl_Size \&| int" *numBytesPtr out Points to space where the number of bytes in the array may be written. Caller may pass NULL when it does not need this information. .BE @@ -134,8 +134,8 @@ and any string representation is invalidated. On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR write the number of bytes in the byte-array value of \fIobjPtr\fR to the space pointed to by \fInumBytesPtr\fR. This space may be of type -\fBsize_t\fR or of type \fBint\fR. It is recommended that callers provide -a \fBsize_t\fR space for this purpose. If the caller provides only +\fBTcl_Size\fR or of type \fBint\fR. It is recommended that callers provide +a \fBTcl_Size\fR space for this purpose. If the caller provides only an \fBint\fR space and the number of bytes in the byte-array value of \fIobjPtr\fR is greater than \fBINT_MAX\fR, the routine will fail due to being unable to correctly report the byte-array size to the caller. diff --git a/doc/Cancel.3 b/doc/Cancel.3 index 4f727b3e785f..a8121cb04eec 100644 --- a/doc/Cancel.3 +++ b/doc/Cancel.3 @@ -26,7 +26,7 @@ Error message to use in the cancellation, or NULL to use a default message. If not NULL, this object will have its reference count decremented before \fBTcl_CancelEval\fR returns. .AP int flags in -ORed combination of flag bits that specify additional options. +OR'ed combination of flag bits that specify additional options. For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently supported. For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and \fBTCL_CANCEL_UNWIND\fR are currently supported. @@ -47,7 +47,7 @@ Extensions can use this function to check to see if they should abort a long running command. This function is thread sensitive and may only be called from the thread the interpreter was created in. .SS "FLAG BITS" -Any ORed combination of the following values may be used for the +Any OR'ed combination of the following values may be used for the \fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR: .TP 20 \fBTCL_CANCEL_UNWIND\fR diff --git a/doc/Class.3 b/doc/Class.3 index c0295953f1eb..888347fdb8bf 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -81,11 +81,11 @@ automatically selected. The name of the namespace to create for the object's private use, or NULL if a new unused name is to be automatically selected. The namespace must not already exist. -.AP size_t objc in +.AP Tcl_Size objc in The number of elements in the \fIobjv\fR array. .AP "Tcl_Obj *const" *objv in The arguments to the command to create the instance of the class. -.AP size_t skip in +.AP Tcl_Size skip in The number of arguments at the start of the argument array, \fIobjv\fR, that are not arguments to any constructors. This allows the generation of correct error messages even when complicated calling patterns are used (e.g., via the diff --git a/doc/Concat.3 b/doc/Concat.3 index 10b4a108b31e..af30cd178e8d 100644 --- a/doc/Concat.3 +++ b/doc/Concat.3 @@ -18,7 +18,7 @@ const char * \fBTcl_Concat\fR(\fIargc, argv\fR) .SH ARGUMENTS .AS "const char *const" argv[] -.AP size_t argc in +.AP Tcl_Size argc in Number of strings. .AP "const char *const" argv[] in Array of strings to concatenate. Must have \fIargc\fR entries. diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3 index 12494bf10438..eec8ed6548d7 100644 --- a/doc/CrtAlias.3 +++ b/doc/CrtAlias.3 @@ -69,12 +69,12 @@ Name of source command for alias. Interpreter that contains the target command for an alias. .AP "const char" *targetCmd in Name of target command for alias in \fItargetInterp\fR. -.AP size_t argc in +.AP Tcl_Size argc in Count of additional arguments to pass to the alias command. .AP "const char *const" *argv in Vector of strings, the additional arguments to pass to the alias command. This storage is owned by the caller. -.AP size_t objc in +.AP Tcl_Size objc in Count of additional value arguments to pass to the aliased command. .AP Tcl_Obj **objv in Vector of Tcl_Obj structures, the additional value arguments to pass to diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index f04fbffe2b9d..6a62c0fedf40 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -141,7 +141,7 @@ means the output handle is wanted. .AP void **handlePtr out Points to the location where the desired OS-specific handle should be stored. -.AP size_t size in +.AP Tcl_Size size in The size, in bytes, of buffers to allocate in this channel. .AP int mask in An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index ffd9e27da273..4bdde44382a5 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -187,7 +187,7 @@ except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. typedef int \fBTcl_ObjCmdProc2\fR( void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, - size_t \fIobjc\fR, + Tcl_Size \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); .CE .PP diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index e4d1a4385fa5..9f74cbf1dda1 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -29,7 +29,7 @@ Tcl_Trace .AS Tcl_CmdObjTraceDeleteProc *deleteProc .AP Tcl_Interp *interp in Interpreter containing command to be traced or untraced. -.AP size_t level in +.AP Tcl_Size level in Only commands at or below this nesting level will be traced unless 0 is specified. 1 means top-level commands only, 2 means top-level commands or those that are @@ -88,10 +88,10 @@ typedef int \fBTcl_CmdObjTraceProc\fR( typedef int \fBTcl_CmdObjTraceProc2\fR( \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, - size_t \fIlevel\fR, + Tcl_Size \fIlevel\fR, const char *\fIcommand\fR, \fBTcl_Command\fR \fIcommandToken\fR, - size_t \fIobjc\fR, + Tcl_Size \fIobjc\fR, \fBTcl_Obj\fR *const \fIobjv\fR[]); .CE .PP diff --git a/doc/DString.3 b/doc/DString.3 index 5c4d8f4f3722..78b2693c5611 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -26,7 +26,7 @@ char * .sp \fBTcl_DStringEndSublist\fR(\fIdsPtr\fR) .sp -size_t +Tcl_Size \fBTcl_DStringLength\fR(\fIdsPtr\fR) .sp char * @@ -51,10 +51,10 @@ Pointer to structure that is used to manage a dynamic string. Pointer to characters to append to dynamic string. .AP "const char" *element in Pointer to characters to append as list element to dynamic string. -.AP size_t length in -Number of bytes from \fIbytes\fR to add to dynamic string. If TCL_INDEX_NONE, +.AP Tcl_Size length in +Number of bytes from \fIbytes\fR to add to dynamic string. If negative, add all characters up to null terminating character. -.AP size_t newLength in +.AP Tcl_Size newLength in New length for dynamic string, not including null terminating character. .AP Tcl_Interp *interp in/out @@ -142,7 +142,8 @@ This saves the cost of allocating new memory and copying the string. an empty string. Since the dynamic string is reinitialized, there is no need to further call \fBTcl_DStringFree\fR on it and it can be reused without -calling \fBTcl_DStringInit\fR. +calling \fBTcl_DStringInit\fR. The caller must ensure that the dynamic +string stored in \fIdsPtr\fR is encoded in Tcl's internal UTF-8 format. .PP \fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR. It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and @@ -150,15 +151,15 @@ it clears \fIinterp\fR's result. If possible it does this by moving a pointer rather than by copying the string. .PP -\fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of -the dynamic string given by \fIdsPtr\fR. It does this by moving -a pointer from \fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR -and reinitializing to dynamic string to an empty string. -This saves the cost of allocating new memory and copying the string. -Since the dynamic string is reinitialized, there is no need to -further call \fBTcl_DStringFree\fR on it and it can be reused without -calling \fBTcl_DStringInit\fR. -The returned \fBTcl_Obj\fR has a reference count of 0. +\fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of the +dynamic string given by \fIdsPtr\fR. It does this by moving a pointer from +\fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR and reinitializing to dynamic +string to an empty string. This saves the cost of allocating new memory and +copying the string. Since the dynamic string is reinitialized, there is no need +to further call \fBTcl_DStringFree\fR on it and it can be reused without calling +\fBTcl_DStringInit\fR. The returned \fBTcl_Obj\fR has a reference count of 0. +The caller must ensure that the dynamic string stored in \fIdsPtr\fR is encoded +in Tcl's internal UTF-8 format. .SH KEYWORDS append, dynamic string, free, result diff --git a/doc/DetachPids.3 b/doc/DetachPids.3 index c4d6fa721728..bff345a03bf1 100644 --- a/doc/DetachPids.3 +++ b/doc/DetachPids.3 @@ -22,7 +22,7 @@ Tcl_Pid \fBTcl_WaitPid\fR(\fIpid, statusPtr, options\fR) .SH ARGUMENTS .AS Tcl_Pid *statusPtr out -.AP size_t numPids in +.AP Tcl_Size numPids in Number of process ids contained in the array pointed to by \fIpidPtr\fR. .AP int *pidPtr in Address of array containing \fInumPids\fR process ids. diff --git a/doc/DictObj.3 b/doc/DictObj.3 index ebff7bfa1619..c046a4221e58 100644 --- a/doc/DictObj.3 +++ b/doc/DictObj.3 @@ -70,7 +70,7 @@ Points to a variable that will have the value from a key/value pair placed within it. For \fBTcl_DictObjFirst\fR and \fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is not interested in the value. -.AP "size_t \&| int" *sizePtr out +.AP "Tcl_Size \&| int" *sizePtr out Points to a variable that will have the number of key/value pairs contained within the dictionary placed within it. .AP Tcl_DictSearch *searchPtr in/out @@ -84,7 +84,7 @@ returned, the search record \fImust\fR be passed to Points to a variable that will have a non-zero value written into it when the enumeration of the key/value pairs in a dictionary has completed, and a zero otherwise. -.AP size_t keyc in +.AP Tcl_Size keyc in Indicates the number of keys that will be supplied in the \fIkeyv\fR array. .AP "Tcl_Obj *const" *keyv in diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 2e50416954de..a1eb265b2c62 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_UtfToExternalDStringEx, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternalDStringEx, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings +Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtfDStringEx, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternalDStringEx, Tcl_UtfToExternal, 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 \fR @@ -25,13 +25,13 @@ int char * \fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp -size_t +int \fBTcl_ExternalToUtfDStringEx\fR(\fIinterp, encoding, src, srcLen, flags, dstPtr, errorIdxPtr\fR) .sp char * \fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp -size_t +int \fBTcl_UtfToExternalDStringEx\fR(\fIinterp, encoding, src, srcLen, flags, dstPtr, errorIdxPtr\fR) .sp int @@ -45,7 +45,7 @@ int const char * \fBTcl_GetEncodingName\fR(\fIencoding\fR) .sp -size_t +Tcl_Size \fBTcl_GetEncodingNulLength\fR(\fIencoding\fR) .sp int @@ -86,7 +86,7 @@ specified encoding that are to be converted to UTF-8. For the UTF-8 characters to be converted to the specified encoding. .AP "const TCHAR" *tsrc in An array of Windows TCHAR characters to convert to UTF-8. -.AP size_t srcLen in +.AP Tcl_Size srcLen in Length of \fIsrc\fR or \fItsrc\fR in bytes. If the length is negative, the encoding-specific length of the string is used. .AP Tcl_DString *dstPtr out @@ -347,7 +347,7 @@ typedef struct Tcl_EncodingType { Tcl_EncodingConvertProc *\fIfromUtfProc\fR; Tcl_EncodingFreeProc *\fIfreeProc\fR; void *\fIclientData\fR; - size_t \fInullSize\fR; + Tcl_Size \fInullSize\fR; } \fBTcl_EncodingType\fR; .CE .PP diff --git a/doc/Ensemble.3 b/doc/Ensemble.3 index b768fd6e92d3..71a53acf22f7 100644 --- a/doc/Ensemble.3 +++ b/doc/Ensemble.3 @@ -69,14 +69,14 @@ The name of the ensemble command to be created. The namespace to which the ensemble command is to be bound, or NULL for the current namespace. .AP int ensFlags in -An ORed set of flag bits describing the basic configuration of the +An OR'ed set of flag bits describing the basic configuration of the ensemble. Currently only one bit has meaning, \fBTCL_ENSEMBLE_PREFIX\fR, which is present when the ensemble command should also match unambiguous prefixes of subcommands. .AP Tcl_Obj *cmdNameObj in A value holding the name of the ensemble command to look up. .AP int flags in -An ORed set of flag bits controlling the behavior of +An OR'ed set of flag bits controlling the behavior of \fBTcl_FindEnsemble\fR. Currently only \fBTCL_LEAVE_ERR_MSG\fR is supported. .AP Tcl_Command token in A normal command token that refers to an ensemble command, or which diff --git a/doc/Eval.3 b/doc/Eval.3 index 8776b2a39cc1..9817cab47079 100644 --- a/doc/Eval.3 +++ b/doc/Eval.3 @@ -46,11 +46,11 @@ modified to hold the result or error message from the script. .AP Tcl_Obj *objPtr in A Tcl value containing the script to execute. .AP int flags in -ORed combination of flag bits that specify additional options. +OR'ed combination of flag bits that specify additional options. \fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported. .AP "const char" *fileName in Name of a file containing a Tcl script. -.AP size_t objc in +.AP Tcl_Size objc in The number of values in the array pointed to by \fIobjv\fR; this is also the number of words in the command. .AP Tcl_Obj **objv in @@ -101,7 +101,7 @@ in code for string comparison, you can use 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 +\fBTcl_EvalObjv\fR executes a single preparsed 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 \fIobjv\fR. \fBTcl_EvalObjv\fR evaluates the command and returns @@ -142,7 +142,7 @@ of arguments. \fBTcl_VarEval\fR is now deprecated. .SH "FLAG BITS" .PP -Any ORed combination of the following values may be used for the +Any OR'ed combination of the following values may be used for the \fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR: .TP 23 \fBTCL_EVAL_DIRECT\fR diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index 469af2241ae1..33becf73cb1a 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -220,9 +220,9 @@ The second of two path values to compare. The value may be converted to \fBpath\fR type. .AP Tcl_Obj *listObj in The list of path elements to operate on with a \fBjoin\fR operation. -.AP size_t elements in +.AP Tcl_Size elements in The number of elements in the \fIlistObj\fR which should -be joined together. If TCL_INDEX_NONE, then all elements are joined. +be joined together. If negative, then all elements are joined. .AP Tcl_Obj **errorPtr out In the case of an error, filled with a value containing the name of the file which caused an error in the various copy/rename operations. @@ -233,7 +233,7 @@ The value to set in the operation. .AP Tcl_Obj **objPtrRef out Filled with a value containing the result of the operation. .AP Tcl_Obj *resultPtr out -Pre-allocated value in which to store (using +Preallocated value in which to store (using \fBTcl_ListObjAppendElement\fR) the list of files or directories which are successfully matched. .AP int mode in @@ -269,11 +269,11 @@ allowed for the \fImode\fR argument to the Tcl \fBopen\fR command. .AP int permissions in POSIX-style permission flags such as 0644. If a new file is created, these permissions will be set on the created file. -.AP "size_t \&| int" *lenPtr out +.AP "Tcl_Size \&| int" *lenPtr out If non-NULL, filled with the number of elements in the split path. .AP Tcl_Obj *basePtr in The base path on to which to join the given elements. May be NULL. -.AP size_t objc in +.AP Tcl_Size objc in The number of elements in \fIobjv\fR. .AP "Tcl_Obj *const" objv[] in The elements to join to the given base path. @@ -483,7 +483,7 @@ is a Tcl_Obj specifying the contents of the symbolic link given by by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link of one of the types passed in in the \fIlinkAction\fR flag. This flag is -an ORed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR. +an OR'ed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR. Where a choice exists (i.e.\ more than one flag is passed in), the Tcl convention is to prefer symbolic links. When a link is successfully created, the return value should be \fItoPtr\fR (which is therefore @@ -678,11 +678,6 @@ of zero, they will be freed when this function returns. \fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid Tcl path type, taking account of the fact that the cwd may have changed even if this value is already supposedly of the correct type. -The filename may begin with -.QW ~ -(to indicate current user's home directory) or -.QW ~ -(to indicate any user's home directory). .PP If the conversion succeeds (i.e.\ the value is a valid path in one of the current filesystems), then \fBTCL_OK\fR is returned. Otherwise @@ -704,14 +699,7 @@ from the given Tcl_Obj. .PP If the translation succeeds (i.e.\ the value is a valid path), then it is returned. Otherwise NULL will be returned, and an error message may be -left in the interpreter. A -.QW translated -path is one which contains no -.QW ~ -or -.QW ~user -sequences (these have been expanded to their current -representation in the filesystem). The value returned is owned by the +left in the interpreter. The value returned is owned by the caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is freed. This function is of little practical use, and \fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually @@ -850,7 +838,7 @@ The \fBTcl_Filesystem\fR structure contains the following fields: .CS typedef struct Tcl_Filesystem { const char *\fItypeName\fR; - size_t \fIstructureLength\fR; + Tcl_Size \fIstructureLength\fR; Tcl_FSVersion \fIversion\fR; Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR; Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR; @@ -1068,9 +1056,7 @@ must have a single unique string representation. Depending on the filesystem, there may be more than one unnormalized string representation which refers to that path (e.g.\ a relative path, a path with different -character case if the filesystem is case insensitive, a path contain a -reference to a home directory such as -.QW ~ , +character case if the filesystem is case insensitive, a path containing symbolic links, etc). If the very last component in the path is a symbolic link, it should not be converted into the value it points to (but diff --git a/doc/IntObj.3 b/doc/IntObj.3 index d2954c87388b..f3683c216137 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -43,6 +43,9 @@ int int \fBTcl_GetWideUIntFromObj\fR(\fIinterp, objPtr, uwidePtr\fR) .sp +int +\fBTcl_GetSizeIntFromObj\fR(\fIinterp, objPtr, sizePtr\fR) +.sp .sp \fB#include \fR .sp @@ -61,7 +64,7 @@ int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out -.AP size_t endValue in +.AP Tcl_Size endValue in \fBTcl_GetIntForIndex\fR will return this when the input value is "end". .AP int intValue in Integer value used to initialize or set a Tcl value. @@ -83,12 +86,14 @@ retrieval fails. Points to place to store the integer value retrieved from \fIobjPtr\fR. .AP long *longPtr out Points to place to store the long integer value retrieved from \fIobjPtr\fR. -.AP size_t *indexPtr out -Points to place to store the size_t value retrieved from \fIobjPtr\fR. +.AP Tcl_Size *indexPtr out +Points to place to store the Tcl_Size value retrieved from \fIobjPtr\fR. .AP Tcl_WideInt *widePtr out Points to place to store the wide integer value retrieved from \fIobjPtr\fR. .AP Tcl_WideUInt *uwidePtr out Points to place to store the unsigned wide integer value retrieved from \fIobjPtr\fR. +.AP Tcl_Size *sizePtr out +Points to place to store the \fBTcl_Size\fR integer value retrieved from \fIobjPtr\fR. .AP mp_int *bigValue in/out Points to a multi-precision integer structure declared by the LibTomMath library. @@ -138,7 +143,8 @@ of \fIobjPtr\fR may be changed to make subsequent calls to the same routine more efficient. .PP The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, -\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and +\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetSizeIntFromObj\fR, +\fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral value of the appropriate type from the Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the value is diff --git a/doc/Limit.3 b/doc/Limit.3 index 43e92f0a2f8f..60817e970357 100644 --- a/doc/Limit.3 +++ b/doc/Limit.3 @@ -65,7 +65,7 @@ its limits checked. .AP int type in The type of limit that the operation refers to. This must be either \fBTCL_LIMIT_COMMANDS\fR or \fBTCL_LIMIT_TIME\fR. -.AP size_t commandLimit in +.AP Tcl_Size commandLimit in The maximum number of commands (as reported by \fBinfo cmdcount\fR) that may be executed in the interpreter. .AP Tcl_Time *timeLimitPtr in/out diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index f7ce3a3a0ff3..42211c5c84f3 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -59,7 +59,7 @@ In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and All the above for both functions may be optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl variable read-only. -.AP size_t size in +.AP Tcl_Size size in .VS "TIP 312" The number of elements in the C array. Must be greater than zero. .VE "TIP 312" diff --git a/doc/ListObj.3 b/doc/ListObj.3 index a0ed5c992121..f63556ba6325 100644 --- a/doc/ListObj.3 +++ b/doc/ListObj.3 @@ -59,13 +59,13 @@ points to the Tcl value that will be appended to \fIlistPtr\fR. For \fBTcl_SetListObj\fR, this points to the Tcl value that will be converted to a list value containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR. -.AP "size_t \&| int" *objcPtr in +.AP "Tcl_Size \&| int" *objcPtr in Points to location where \fBTcl_ListObjGetElements\fR stores the number of element values in \fIlistPtr\fR. .AP Tcl_Obj ***objvPtr out A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array of pointers to the element values of \fIlistPtr\fR. -.AP size_t objc in +.AP Tcl_Size objc in The number of Tcl values that \fBTcl_NewListObj\fR will insert into a new list value, and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR. @@ -76,21 +76,21 @@ An array of pointers to values. \fBTcl_NewListObj\fR will insert these values into a new list value and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR. Each value will become a separate list element. -.AP "size_t \&| int" *lengthPtr out +.AP "Tcl_Size \&| int" *lengthPtr out Points to location where \fBTcl_ListObjLength\fR stores the length of the list. -.AP size_t index in +.AP Tcl_Size index in Index of the list element that \fBTcl_ListObjIndex\fR is to return. The first element has index 0. .AP Tcl_Obj **objPtrPtr out Points to place where \fBTcl_ListObjIndex\fR is to store a pointer to the resulting list element value. -.AP size_t first in +.AP Tcl_Size first in Index of the starting list element that \fBTcl_ListObjReplace\fR is to replace. The list's first element has index 0. -.AP size_t count in +.AP Tcl_Size count in The number of elements that \fBTcl_ListObjReplace\fR is to replace. .BE @@ -184,7 +184,7 @@ if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. If the index is out of range, -that is, \fIindex\fR is TCL_INDEX_NONE or +that is, \fIindex\fR is negative or greater than or equal to the number of elements in the list, \fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR and returns \fBTCL_OK\fR. @@ -203,13 +203,13 @@ and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. Otherwise, it returns \fBTCL_OK\fR after replacing the values. If \fIobjv\fR is NULL, no new elements are added. -If the argument \fIfirst\fR is zero or TCL_INDEX_NONE, +If the argument \fIfirst\fR is zero or negative, it refers to the first element. If \fIfirst\fR is greater than or equal to the number of elements in the list, then no elements are deleted; the new elements are appended to the list. \fIcount\fR gives the number of elements to replace. -If \fIcount\fR is zero or TCL_INDEX_NONE then no elements are deleted; +If \fIcount\fR is zero or negative then no elements are deleted; the new elements are simply inserted before the one designated by \fIfirst\fR. \fBTcl_ListObjReplace\fR invalidates \fIlistPtr\fR's diff --git a/doc/Method.3 b/doc/Method.3 index c3a6b6460afc..377fc5a73e88 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -58,7 +58,7 @@ Tcl_Method Tcl_Object \fBTcl_ObjectContextObject\fR(\fIcontext\fR) .sp -size_t +Tcl_Size \fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR) .SH ARGUMENTS .AS void *clientData in @@ -95,11 +95,11 @@ A reference to a method to query. .AP Tcl_ObjectContext context in A reference to a method-call context. Note that client code \fImust not\fR retain a reference to a context. -.AP size_t objc in +.AP Tcl_Size objc in The number of arguments to pass to the method implementation. .AP "Tcl_Obj *const" *objv in An array of arguments to pass to the method implementation. -.AP size_t skip in +.AP Tcl_Size skip in The number of arguments passed to the method implementation that do not represent "real" arguments. .BE diff --git a/doc/NRE.3 b/doc/NRE.3 index a6e741a961b9..62184f948812 100644 --- a/doc/NRE.3 +++ b/doc/NRE.3 @@ -69,7 +69,7 @@ and \fIobjProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in/out Called before \fIcmdName\fR is deleted from the interpreter, allowing for command-specific cleanup. May be NULL. -.AP size_t objc in +.AP Tcl_Size objc in Number of items in \fIobjv\fR. .AP Tcl_Obj **objv in Words in the command. diff --git a/doc/Number.3 b/doc/Number.3 index f4050606b474..1bf018a37a21 100644 --- a/doc/Number.3 +++ b/doc/Number.3 @@ -27,9 +27,9 @@ When non-NULL, error information is recorded here when the value is not in any of the numeric formats recognized by Tcl. .AP "const char" *bytes in Points to first byte of the string value to be examined. -.AP size_t numBytes in +.AP Tcl_Size numBytes in The number of bytes, starting at \fIbytes\fR, that should be examined. -If the value \fBTCL_INDEX_NONE\fR is provided, then all bytes should +If \fBnumBytes\fR is negative, then all bytes should be examined until the first \fBNUL\fR byte terminates examination. .AP "void *" *clientDataPtr out Points to space where a pointer value may be written through which a numeric @@ -63,7 +63,7 @@ the same function. They differ only in how the arguments present the Tcl value to be examined. \fBTcl_GetNumber\fR accepts a counted string value in the arguments \fIbytes\fR and \fInumBytes\fR (or a \fBNUL\fR-terminated string value when \fInumBytes\fR is -\fBTCL_INDEX_NONE\fR). \fBTcl_GetNumberFromObj\fR accepts the Tcl value +negative). \fBTcl_GetNumberFromObj\fR accepts the Tcl value in \fIobjPtr\fR. .PP Both routines examine the Tcl value and determine whether Tcl recognizes diff --git a/doc/Object.3 b/doc/Object.3 index 91ee3977c495..fc796439e263 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -111,9 +111,9 @@ which is defined as follows. .PP .CS typedef struct Tcl_Obj { - size_t \fIrefCount\fR; + Tcl_Size \fIrefCount\fR; char *\fIbytes\fR; - size_t \fIlength\fR; + Tcl_Size \fIlength\fR; const Tcl_ObjType *\fItypePtr\fR; union { long \fIlongValue\fR; diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 1b9d5d3e3bd1..3a7b6ae16a9c 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -53,28 +53,28 @@ int int \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR) .sp -size_t +Tcl_Size \fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR) .sp -size_t +Tcl_Size \fBTcl_Gets\fR(\fIchannel, lineRead\fR) .sp -size_t +Tcl_Size \fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR) .sp -size_t +Tcl_Size \fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR) .sp -size_t +Tcl_Size \fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR) .sp -size_t +Tcl_Size \fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp -size_t +Tcl_Size \fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR) .sp -size_t +Tcl_Size \fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp int @@ -119,7 +119,7 @@ allowed for the \fImode\fR argument to the Tcl \fBopen\fR command. .AP int permissions in POSIX-style permission flags such as 0644. If a new file is created, these permissions will be set on the created file. -.AP size_t argc in +.AP Tcl_Size argc in The number of elements in \fIargv\fR. .AP "const char" **argv in Arguments for constructing a command pipeline. These values have the same @@ -154,7 +154,7 @@ from a procedure such as \fBTcl_OpenFileChannel\fR. .AP Tcl_Obj *readObjPtr in/out A pointer to a Tcl value in which to store the characters read from the channel. -.AP size_t charsToRead in +.AP Tcl_Size charsToRead in The number of characters to read from the channel. If the channel's encoding is \fBbinary\fR, this is equivalent to the number of bytes to read from the channel. @@ -163,7 +163,7 @@ If non-zero, data read from the channel will be appended to the value. Otherwise, the data will replace the existing contents of the value. .AP char *readBuf out A buffer in which to store the bytes read from the channel. -.AP size_t bytesToRead in +.AP Tcl_Size bytesToRead in The number of bytes to read from the channel. The buffer \fIreadBuf\fR must be large enough to hold this many bytes. .AP Tcl_Obj *lineObjPtr in/out @@ -176,7 +176,7 @@ channel. Must have been initialized by the caller. The line read will be appended to any data already in the dynamic string. .AP "const char" *input in The input to add to a channel buffer. -.AP size_t inputLen in +.AP Tcl_Size inputLen in Length of the input .AP int addAtEnd in Flag indicating whether the input should be added to the end or @@ -187,7 +187,7 @@ A pointer to a Tcl value whose contents will be output to the channel. A buffer containing the characters to output to the channel. .AP "const char" *byteBuf in A buffer containing the bytes to output to the channel. -.AP size_t bytesToWrite in +.AP Tcl_Size bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. .AP "long long" offset in @@ -406,10 +406,10 @@ to UTF-8 based on the channel's encoding and storing the produced data in \fIreadObjPtr\fR's string representation. The return value of \fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR, that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the -return value is TCL_INDEX_NONE and \fBTcl_ReadChars\fR records a POSIX error code that +return value is -1 and \fBTcl_ReadChars\fR records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. .PP -Setting \fIcharsToRead\fR to TCL_INDEX_NONE will cause the command to read +Setting \fIcharsToRead\fR to -1 will cause the command to read all characters currently available (non-blocking) or everything until eof (blocking mode). .PP @@ -471,14 +471,14 @@ character(s) are read and discarded. .PP If a line was successfully read, the return value is greater than or equal to zero and indicates the number of bytes stored in \fIlineObjPtr\fR. If an -error occurs, \fBTcl_GetsObj\fR returns TCL_INDEX_NONE and records a POSIX error code +error occurs, \fBTcl_GetsObj\fR returns -1 and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. \fBTcl_GetsObj\fR also -returns TCL_INDEX_NONE if the end of the file is reached; the \fBTcl_Eof\fR procedure +returns -1 if the end of the file is reached; the \fBTcl_Eof\fR procedure can be used to distinguish an error from an end-of-file condition. .PP -If the channel is in nonblocking mode, the return value can also be TCL_INDEX_NONE +If the channel is in nonblocking mode, the return value can also be -1 if no data was available or the data that was available did not contain an -end-of-line character. When TCL_INDEX_NONE is returned, the \fBTcl_InputBlocked\fR +end-of-line character. When -1 is returned, the \fBTcl_InputBlocked\fR procedure may be invoked to determine if the channel is blocked because of input unavailability. .PP @@ -496,7 +496,7 @@ head of the queue. If \fIchannel\fR has a .QW sticky EOF set, no data will be added to the input queue. \fBTcl_Ungets\fR returns \fIinputLen\fR or -TCL_INDEX_NONE if an error occurs. +-1 if an error occurs. .SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE" .PP \fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at @@ -513,7 +513,7 @@ to appear as soon as a complete line is accepted for output, set the \fB\-buffering\fR option on the channel to \fBline\fR mode. .PP The return value of \fBTcl_WriteChars\fR is a count of how many bytes were -accepted for output to the channel. This is either TCL_INDEX_NONE to +accepted for output to the channel. This is either -1 to indicate that an error occurred or another number greater than zero to indicate success. If an error occurs, \fBTcl_WriteChars\fR records a POSIX error code that may be retrieved with \fBTcl_GetErrno\fR. @@ -599,7 +599,7 @@ their possible values are described in the manual entry for the Tcl \fBfconfigure\fR command. Other options can be added by each channel type. These channel type specific options are described in the manual entry for the Tcl command that creates a channel of that type; for example, the -additional options for TCP based channels are described in the manual entry +additional options for TCP-based channels are described in the manual entry for the Tcl \fBsocket\fR command. The procedure normally returns \fBTCL_OK\fR. If an error occurs, it returns \fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an appropriate POSIX diff --git a/doc/Panic.3 b/doc/Panic.3 index e8a5cb88dae8..2f5d19c1d031 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -27,10 +27,6 @@ void A printf-style format string. .AP "" arg in Arguments matching the format string. -.AP va_list argList in -An argument list of arguments matching the format string. -Must have been initialized using \fBva_start\fR, -and cleared using \fBva_end\fR. .AP Tcl_PanicProc *panicProc in Procedure to report fatal error message and abort. .BE diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index 6a5184f5501e..7f81fb7a7e3b 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -21,7 +21,7 @@ int Where to store error messages. .AP "const Tcl_ArgvInfo" *argTable in Pointer to array of option descriptors. -.AP "size_t \&| int" *objcPtr in/out +.AP "Tcl_Size \&| int" *objcPtr in/out A pointer to variable holding number of arguments in \fIobjv\fR. Will be modified to hold number of arguments left in the unprocessed argument list stored in \fIremObjv\fR. diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 5235325c0582..09192997f63e 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -45,7 +45,7 @@ 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 size_t numBytes in +.AP Tcl_Size numBytes in Number of bytes in string to parse, not including any terminating null character. If less than 0 then the script consists of all characters following \fIstart\fR up to the first null character. @@ -196,20 +196,20 @@ return parse information in two data structures, Tcl_Parse and Tcl_Token: .CS typedef struct Tcl_Parse { const char *\fIcommentStart\fR; - size_t \fIcommentSize\fR; + Tcl_Size \fIcommentSize\fR; const char *\fIcommandStart\fR; - size_t \fIcommandSize\fR; - size_t \fInumWords\fR; + Tcl_Size \fIcommandSize\fR; + Tcl_Size \fInumWords\fR; Tcl_Token *\fItokenPtr\fR; - size_t \fInumTokens\fR; + Tcl_Size \fInumTokens\fR; ... } \fBTcl_Parse\fR; typedef struct Tcl_Token { int \fItype\fR; const char *\fIstart\fR; - size_t \fIsize\fR; - size_t \fInumComponents\fR; + Tcl_Size \fIsize\fR; + Tcl_Size \fInumComponents\fR; } \fBTcl_Token\fR; .CE .PP diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index 893213546cc7..1b76ed61ca43 100644 --- a/doc/PkgRequire.3 +++ b/doc/PkgRequire.3 @@ -55,7 +55,7 @@ Pointer to place to store the value associated with the matching package. It is only changed if the pointer is not NULL and the function completed successfully. The storage can be any pointer type with the same size as a void pointer. -.AP size_t objc in +.AP Tcl_Size objc in Number of requirements. .AP Tcl_Obj* objv[] in Array of requirements. diff --git a/doc/RegExp.3 b/doc/RegExp.3 index 86c3a5567913..f173b029561f 100644 --- a/doc/RegExp.3 +++ b/doc/RegExp.3 @@ -64,7 +64,7 @@ identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. -.AP size_t index in +.AP Tcl_Size index in Specifies which range is desired: 0 means the range of the entire match, 1 or greater means the range that matched a parenthesized sub-expression. @@ -80,14 +80,14 @@ OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR, \fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR, \fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and \fBTCL_REG_CANMATCH\fR. See below for more information. -.AP size_t offset in +.AP Tcl_Size offset in The character offset into the text where matching should begin. The value of the offset has no impact on \fB^\fR matches. This behavior is controlled by \fIeflags\fR. -.AP size_t nmatches in +.AP Tcl_Size nmatches in The number of matching subexpressions that should be remembered for later use. If this value is 0, then no subexpression match -information will be computed. If the value is TCL_INDEX_NONE, then +information will be computed. If the value is negative, then all of the matching subexpressions will be remembered. Any other value will be taken as the maximum number of subexpressions to remember. @@ -337,9 +337,9 @@ defined as follows: .PP .CS typedef struct Tcl_RegExpInfo { - size_t \fInsubs\fR; + Tcl_Size \fInsubs\fR; Tcl_RegExpIndices *\fImatches\fR; - size_t \fIextendStart\fR; + Tcl_Size \fIextendStart\fR; } \fBTcl_RegExpInfo\fR; .CE .PP @@ -355,8 +355,8 @@ follows: .PP .CS typedef struct Tcl_RegExpIndices { - size_t \fIstart\fR; - size_t \fIend\fR; + Tcl_Size \fIstart\fR; + Tcl_Size \fIend\fR; } \fBTcl_RegExpIndices\fR; .CE .PP diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index 0358cc910b2c..171d29d4c4ba 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -14,14 +14,14 @@ Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter .nf \fB#include \fR .sp -size_t +Tcl_Size \fBTcl_SetRecursionLimit\fR(\fIinterp, depth\fR) .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in Interpreter whose recursion limit is to be set. Must be greater than zero. -.AP size_t depth in +.AP Tcl_Size depth in New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .BE diff --git a/doc/SetResult.3 b/doc/SetResult.3 index 42e3ce0ec804..fdc4af25665a 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -34,213 +34,105 @@ const char * .SH ARGUMENTS .AS Tcl_FreeProc sourceInterp out .AP Tcl_Interp *interp out -Interpreter whose result is to be modified or read. +The interpreter get or set the result for. .AP Tcl_Obj *objPtr in -Tcl value to become result for \fIinterp\fR. +A value to set the result to. .AP char *result in -String value to become result for \fIinterp\fR or to be -appended to the existing result. +The string value set the result to, or to append to the existing result. .AP "const char" *element in -String value to append as a list element +The string value to append as a list element to the existing result of \fIinterp\fR. .AP Tcl_FreeProc *freeProc in -Address of procedure to call to release storage at -\fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or -\fBTCL_VOLATILE\fR. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. +Pointer to a procedure to call to release storage at +\fIresult\fR. .AP Tcl_Interp *sourceInterp in -Interpreter that the result and return options should be transferred from. +The interpreter to transfer the result and return options from. .AP Tcl_Interp *targetInterp in -Interpreter that the result and return options should be transferred to. +The interpreter to transfer the result and return options to. .AP int code in Return code value that controls transfer of return options. .BE .SH DESCRIPTION .PP -The procedures described here are utilities for manipulating the -result value in a Tcl interpreter. -The interpreter result may be either a Tcl value or a string. -For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR -set the interpreter result to, respectively, a value and a string. -Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR -return the interpreter result as a value and as a string. -The procedures always keep the string and value forms -of the interpreter result consistent. -For example, if \fBTcl_SetObjResult\fR is called to set -the result to a value, -then \fBTcl_GetStringResult\fR is called, -it will return the value's string representation. +These procedures manipulate the result of an interpreter. Some procedures +provide a Tcl_Obj interface while others provide a string interface. For +example, \fBTcl_SetObjResult\fR accepts a Tcl_Obj and \fBTcl_SetResult\fR +accepts a char *. Similarly, \fBTcl_GetObjResult\fR produces a Tcl_Obj * and +\fBTcl_GetStringResult\fR produces a char *. The procedures can be mixed and +matched. For example, if \fBTcl_SetObjResult\fR is called to set the result to +a Tcl_Obj value, and then \fBTcl_GetStringResult\fR is called, it returns a +char * (but see caveats below). .PP -\fBTcl_SetObjResult\fR -arranges for \fIobjPtr\fR to be the result for \fIinterp\fR, +\fBTcl_SetObjResult\fR sets \fIobjPtr\fR as the result for \fIinterp\fR, replacing any existing result. -The result is left pointing to the value -referenced by \fIobjPtr\fR. -\fIobjPtr\fR's reference count is incremented -since there is now a new reference to it from \fIinterp\fR. -The reference count for any old result value -is decremented and the old result value is freed if no -references to it remain. .PP -\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as a value. -The value's reference count is not incremented; -if the caller needs to retain a long-term pointer to the value -they should use \fBTcl_IncrRefCount\fR to increment its reference count -in order to keep it from being freed too early or accidentally changed. -.PP -\fBTcl_SetResult\fR -arranges for \fIresult\fR to be the result for the current Tcl -command in \fIinterp\fR, replacing any existing result. -The \fIfreeProc\fR argument specifies how to manage the storage -for the \fIresult\fR argument; -it is discussed in the section -\fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below. -If \fIresult\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored -and \fBTcl_SetResult\fR -re-initializes \fIinterp\fR's result to point to an empty string. -.PP -\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string. -If the result was set to a value by a \fBTcl_SetObjResult\fR call, -the value form will be converted to a string and returned. -If the value's string representation contains null bytes, -this conversion will lose information. -For this reason, programmers are encouraged to -write their code to use the new value API procedures -and to call \fBTcl_GetObjResult\fR instead. -.PP -\fBTcl_ResetResult\fR clears the result for \fIinterp\fR -and leaves the result in its normal empty initialized state. -If the result is a value, -its reference count is decremented and the result is left -pointing to an unshared value representing an empty string. -If the result is a dynamically allocated string, its memory is free*d -and the result is left as a empty string. -\fBTcl_ResetResult\fR also clears the error state managed by -\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR, -and \fBTcl_SetErrorCode\fR. -.PP -\fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces. -It takes each of its \fIresult\fR arguments and appends them in order -to the current result associated with \fIinterp\fR. -If the result is in its initialized empty state (e.g. a command procedure -was just invoked or \fBTcl_ResetResult\fR was just called), -then \fBTcl_AppendResult\fR sets the result to the concatenation of -its \fIresult\fR arguments. -\fBTcl_AppendResult\fR may be called repeatedly as additional pieces -of the result are produced. -\fBTcl_AppendResult\fR takes care of all the -storage management issues associated with managing \fIinterp\fR's -result, such as allocating a larger result area if necessary. -It also manages conversion to and from the \fIresult\fR field of the -\fIinterp\fR so as to handle backward-compatibility with old-style -extensions. -Any number of \fIresult\fR arguments may be passed in a single -call; the last argument in the list must be a NULL pointer. -.PP -\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR -to \fItargetInterp\fR. The two interpreters must have been created in the -same thread. If \fIsourceInterp\fR and \fItargetInterp\fR are the same, -nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result -from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result -in \fIsourceInterp\fR. It also moves the return options dictionary as -controlled by the return code value \fIcode\fR in the same manner +\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR, without +incrementing its reference count. +.PP +\fBTcl_SetResult\fR sets \fIresult\fR as the result for \fIinterp\fR, replacing +any existing result, and calls \fIfreeProc\fR to free \fIresult\fR. See \fBTHE +TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below. If \fIresult\fR is +\fBNULL\fR, ignores \fIfreeProc\fR and sets the result for \fIinterp\fR to +point to the empty string. +.PP +\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string, i.e. +the bytes of the Tcl_Obj for the result, which can be decoded using +\fBTcl_UtfToExternal\fR. This value is freed when its corresponding Tcl_Obj is +freed.Programmers are encouraged to use the newer Tcl_Obj API procedures, e.g. +to call \fBTcl_GetObjResult\fR instead. +.PP +\fBTcl_ResetResult\fR sets the empty string as the result for \fIinterp\fR and +clears the error state managed by \fBTcl_AddErrorInfo\fR, +\fBTcl_AddObjErrorInfo\fR, and \fBTcl_SetErrorCode\fR. +.PP +\fBTcl_AppendResult\fR builds up a result from smaller pieces, appending each +\fIresult\fR in order to the current result for \fIinterp\fR. It may be called +repeatedly as additional pieces of the result are produced, and manages the +storage for the \fIinterp\fR's result, allocating a larger result area if +necessary. It also manages conversion to and from the \fIresult\fR field of +the \fIinterp\fR to handle backward-compatibility with old-style extensions. +Any number of \fIresult\fR arguments may be passed in a single call; the last +argument in the list must be a NULL pointer. +.PP +\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR to +\fItargetInterp\fR, both of which must have been created in the same thread, +resets the result in \fIsourceInterp\fR, and moves the return options +dictionary as controlled by the return code value \fIcode\fR in the same manner as \fBTcl_GetReturnOptions\fR. +.PP +If \fIsourceInterp\fR and \fItargetInterp\fR are the same, nothing is done. .SH "DEPRECATED INTERFACES" .SS "OLD STRING PROCEDURES" .PP -Use of the following procedures is deprecated -since they manipulate the Tcl result as a string. -Procedures such as \fBTcl_SetObjResult\fR -that manipulate the result as a value -can be significantly more efficient. -.PP -\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in -that it allows results to be built up in pieces. -However, \fBTcl_AppendElement\fR takes only a single \fIelement\fR -argument and it appends that argument to the current result -as a proper Tcl list element. -\fBTcl_AppendElement\fR adds backslashes or braces if necessary -to ensure that \fIinterp\fR's result can be parsed as a list and that -\fIelement\fR will be extracted as a single element. -Under normal conditions, \fBTcl_AppendElement\fR will add a space -character to \fIinterp\fR's result just before adding the new -list element, so that the list elements in the result are properly -separated. -However if the new list element is the first in a list or sub-list -(i.e. \fIinterp\fR's current result is empty, or consists of the -single character +The following procedures are deprecated since they manipulate the Tcl result as +a string. Procedures such as \fBTcl_SetObjResult\fR can be significantly more +efficient. +.PP +\fBTcl_AppendElement\fR is like \fBTcl_AppendResult\fR, but it appends only one +piece, and also appends that piece as a list item. +\fBTcl_AppendElement\fR adds backslashes or braces as necessary to ensure that +\fIelement\fR is properly formatted as a list item. Under normal conditions, +\fBTcl_AppendElement\fR adds a space character to \fIinterp\fR's result just +before adding the new list element, so that the list elements in the result are +properly separated. However if the new list element is the first item in the +list or sublist (i.e. \fIinterp\fR's current result is empty, or consists of +the single character .QW { , or ends in the characters .QW " {" ) then no space is added. .SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT" .PP -\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how -the Tcl system is to manage the storage for the \fIresult\fR argument. -If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called -at a time when \fIinterp\fR holds a string result, -they do whatever is necessary to dispose of the old string result -(see the \fBTcl_Interp\fR manual entry for details on this). -.PP -If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIresult\fR -refers to an area of static storage that is guaranteed not to be -modified until at least the next call to \fBTcl_Eval\fR. -If \fIfreeProc\fR -is \fBTCL_DYNAMIC\fR it means that \fIresult\fR was allocated with a call -to \fBTcl_Alloc\fR and is now the property of the Tcl system. -\fBTcl_SetResult\fR will arrange for the string's storage to be -released by calling \fBTcl_Free\fR when it is no longer needed. -If \fIfreeProc\fR is \fBTCL_VOLATILE\fR it means that \fIresult\fR -points to an area of memory that is likely to be overwritten when -\fBTcl_SetResult\fR returns (e.g. it points to something in a stack frame). -In this case \fBTcl_SetResult\fR will make a copy of the string in -dynamically allocated storage and arrange for the copy to be the -result for the current Tcl command. -.PP -If \fIfreeProc\fR is not one of the values \fBTCL_STATIC\fR, -\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address -of a procedure that Tcl should call to free the string. -This allows applications to use non-standard storage allocators. -When Tcl no longer needs the storage for the string, it will -call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and -result that match the type \fBTcl_FreeProc\fR: +\fIFreeProc\fR has the following type: .PP .CS typedef void \fBTcl_FreeProc\fR( char *\fIblockPtr\fR); .CE .PP -When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to -the value of \fIresult\fR passed to \fBTcl_SetResult\fR. +When \fIfreeProc\fR is called, \fIblockPtr\fR is the \fIresult\fR value passed +to \fBTcl_SetResult\fR. -.SH "REFERENCE COUNT MANAGEMENT" -.PP -The interpreter result is one of the main places that owns references to -values, along with the bytecode execution stack, argument lists, variables, -and the list and dictionary collection values. -.PP -\fBTcl_SetObjResult\fR takes a value with an arbitrary reference count -\fI(specifically including zero)\fR and guarantees to increment the reference -count. If code wishes to continue using the value after setting it as the -result, it should add its own reference to it with \fBTcl_IncrRefCount\fR. -.PP -\fBTcl_GetObjResult\fR returns the current interpreter result value. This will -have a reference count of at least 1. If the caller wishes to keep the -interpreter result value, it should increment its reference count. -.PP -\fBTcl_GetStringResult\fR does not manipulate reference counts, but the string -it returns is owned by (and has a lifetime controlled by) the current -interpreter result value; it should be copied instead of being relied upon to -persist after the next Tcl API call, as most Tcl operations can modify the -interpreter result. -.PP -\fBTcl_SetResult\fR, \fBTcl_AppendResult\fR, \fBTcl_AppendResultVA\fR, -\fBTcl_AppendElement\fR, and \fBTcl_ResetResult\fR all modify the interpreter -result. They may cause the old interpreter result to have its reference count -decremented and a new interpreter result to be allocated. After they have been -called, the reference count of the interpreter result is guaranteed to be 1. .SH "SEE ALSO" Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp, Tcl_GetReturnOptions diff --git a/doc/SetVar.3 b/doc/SetVar.3 index eb8333b616cc..9d8e0b7d48b1 100644 --- a/doc/SetVar.3 +++ b/doc/SetVar.3 @@ -250,18 +250,18 @@ and \fBTcl_ObjGetVar2\fR is (if non-NULL) a value with a reference of at least operated upon. .PP The \fInewValuePtr\fR argument to \fBTcl_SetVar2Ex\fR and \fBTcl_ObjSetVar2\fR -may be an arbitrary reference count value; its reference count will be -incremented on success. However, it is recommended to not use a zero reference -count value, as that makes correct handling of the error case tricky. +may be an arbitrary reference count value. Its reference count is +incremented on success. On failure, if its reference count is zero, it is +decremented and freed so the caller need do nothing with it. .PP -The \fIpart1\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR can -have any reference count; these functions never modify it. It is recommended -to not use a zero reference count for this argument. +The \fIpart1Ptr\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR can +have any reference count. These functions never modify it. .PP -The \fIpart2\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR, if +The \fIpart2Ptr\fR argument to \fBTcl_ObjSetVar2\fR and \fBTcl_ObjGetVar2\fR, if non-NULL, should not have a zero reference count as these functions may -retain a reference to it (particularly when it is used to create an array -element that did not previously exist). +retain a reference to it, particularly when it is used to create an array +element that did not previously exist, and decrementing the reference count +later would leave them pointing to a freed Tcl_Obj. .SH "SEE ALSO" Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar diff --git a/doc/SplitList.3 b/doc/SplitList.3 index 6d9a9aa94376..cc156ee57bec 100644 --- a/doc/SplitList.3 +++ b/doc/SplitList.3 @@ -20,16 +20,16 @@ int char * \fBTcl_Merge\fR(\fIargc, argv\fR) .sp -size_t +Tcl_Size \fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR) .sp -size_t +Tcl_Size \fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR) .sp -size_t +Tcl_Size \fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR) .sp -size_t +Tcl_Size \fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr out @@ -38,14 +38,14 @@ Interpreter to use for error reporting. If NULL, then no error message is left. .AP "const char" *list in Pointer to a string with proper list structure. -.AP "size_t \&| int" *argcPtr out +.AP "Tcl_Size \&| int" *argcPtr out Filled in with number of elements in \fIlist\fR. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of pointers to the strings that are the extracted elements of \fIlist\fR. There will be \fI*argcPtr\fR valid entries in the array, followed by a NULL entry. -.AP size_t argc in +.AP Tcl_Size argc in Number of elements in \fIargv\fR. .AP "const char *const" *argv in Array of strings to merge together into a single list. @@ -55,7 +55,7 @@ String that is to become an element of a list. .AP int *flagsPtr in Pointer to word to fill in with information about \fIsrc\fR. The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR. -.AP size_t length in +.AP Tcl_Size length in Number of bytes in string \fIsrc\fR. .AP char *dst in Place to copy converted list element. Must contain enough characters @@ -81,7 +81,7 @@ For example, suppose that you have called \fBTcl_SplitList\fR with the following code: .PP .CS -size_t argc; +Tcl_Size argc; int code; char *string; char **argv; diff --git a/doc/SplitPath.3 b/doc/SplitPath.3 index 10e84f5d0c03..1e90ab07be21 100644 --- a/doc/SplitPath.3 +++ b/doc/SplitPath.3 @@ -25,14 +25,14 @@ Tcl_PathType .AP "const char" *path in File path in a form appropriate for the current platform (see the \fBfilename\fR manual entry for acceptable forms for path names). -.AP "size_t \&| int" *argcPtr out +.AP "Tcl_Size \&| int" *argcPtr out Filled in with number of path elements in \fIpath\fR. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of pointers to the strings that are the extracted elements of \fIpath\fR. There will be \fI*argcPtr\fR valid entries in the array, followed by a NULL entry. -.AP size_t argc in +.AP Tcl_Size argc in Number of elements in \fIargv\fR. .AP "const char *const" *argv in Array of path elements to merge together into a single path. @@ -61,7 +61,7 @@ For example, suppose that you have called \fBTcl_SplitPath\fR with the following code: .PP .CS -size_t argc; +Tcl_Size argc; char *path; char **argv; \&... diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 2d4101873a85..f8c3a583252d 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -40,7 +40,7 @@ Tcl_UniChar * int \fBTcl_GetUniChar\fR(\fIobjPtr, index\fR) .sp -size_t +Tcl_Size \fBTcl_GetCharLength\fR(\fIobjPtr\fR) .sp Tcl_Obj * @@ -87,46 +87,43 @@ Tcl_Obj * Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters -unless \fInumChars\fR is \fBTCL_INDEX_NONE\fR. (Applications needing null bytes +unless \fInumChars\fR is negative. (Applications needing null bytes should represent them as the two-byte sequence \fI\e300\e200\fR, use \fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if the string is a collection of uninterpreted bytes.) -.AP size_t length in +.AP Tcl_Size length in The number of bytes to copy from \fIbytes\fR when initializing, setting, or appending to a string value. -If \fBTCL_INDEX_NONE\fR, all bytes up to the first null are used. +If negative, all bytes up to the first null are used. .AP "const Tcl_UniChar" *unicode in Points to the first byte of an array of Unicode characters used to set or append to a string value. This byte array may contain embedded null characters -unless \fInumChars\fR is \fBTCL_INDEX_NONE\fR. -.AP size_t numChars in +unless \fInumChars\fR is negative. +.AP Tcl_Size numChars in The number of Unicode characters to copy from \fIunicode\fR when initializing, setting, or appending to a string value. -If \fBTCL_INDEX_NONE\fR, all characters up to the first null character are used. -.AP size_t index in +If negative, all characters up to the first null character are used. +.AP Tcl_Size index in The index of the Unicode character to return. -.AP size_t first in +.AP Tcl_Size first in The index of the first Unicode character in the Unicode range to be -returned as a new value. If \fBTCL_INDEX_NONE\fR, behave the same as if the +returned as a new value. If negative, behave the same as if the value was 0. -.AP size_t last in +.AP Tcl_Size last in The index of the last Unicode character in the Unicode range to be -returned as a new value. If \fBTCL_INDEX_NONE\fR, take all characters up to +returned as a new value. If negative, take all characters up to the last one available. .AP Tcl_Obj *objPtr in/out -Points to a value to manipulate. +A pointer to a value to read, or to an unshared value to modify. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. -.AP "size_t \&| int" *lengthPtr out +.AP "Tcl_Size \&| int" *lengthPtr out The location where \fBTcl_GetStringFromObj\fR will store the length of a value's string representation. May be (int *)NULL when not used. .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. -.AP va_list argList in -An argument list which must have been initialized using -\fBva_start\fR, and cleared using \fBva_end\fR. -.AP size_t limit in +.AP Tcl_Size limit in Maximum number of bytes to be appended. .AP "const char" *ellipsis in Suffix to append when the limit leads to string truncation. @@ -135,11 +132,11 @@ If NULL is passed then the suffix is used. .AP "const char" *format in Format control string including % conversion specifiers. -.AP size_t objc in +.AP Tcl_Size objc in The number of elements to format or concatenate. .AP Tcl_Obj *objv[] in The array of values to format or concatenate. -.AP size_t newLength in +.AP Tcl_Size newLength in New length for the string value of \fIobjPtr\fR, not including the final null character. .BE @@ -213,8 +210,8 @@ it references a low surrogate preceded by a high surrogate, it returns -1; characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's Unicode representation. If the value's Unicode representation is invalid, the Unicode representation is regenerated from the value's -string representation. If \fIfirst\fR == TCL_INDEX_NONE, then the returned -string starts at the beginning of the value. If \fIlast\fR == TCL_INDEX_NONE, +string representation. If \fIfirst\fR is negative, then the returned +string starts at the beginning of the value. If \fIlast\fR negative, then the returned string ends at the end of the value. .PP \fBTcl_GetCharLength\fR returns the number of characters (as opposed @@ -263,7 +260,7 @@ all \fIlength\fR bytes that are available from being appended, then the appending is done so that the last bytes appended are from the string \fIellipsis\fR. This allows for an indication of the truncation to be left in the string. -When \fIlength\fR is \fBTCL_INDEX_NONE\fR, all bytes up to the first zero byte are appended, +When \fIlength\fR is negative, all bytes up to the first zero byte are appended, subject to the limit. When \fIellipsis\fR is NULL, the default string \fB...\fR is used. When \fIellipsis\fR is non-NULL, it must point to a zero-byte-terminated string in Tcl's internal UTF encoding. @@ -306,7 +303,7 @@ functionality is needed. .CS char buf[SOME_SUITABLE_LENGTH]; sprintf(buf, format, ...); -\fBTcl_NewStringObj\fR(buf, \fBTCL_INDEX_NONE\fR); +\fBTcl_NewStringObj\fR(buf, -1); .CE .PP but with greater convenience and no need to diff --git a/doc/SubstObj.3 b/doc/SubstObj.3 index fa30fb125c63..f10e01d33b8c 100644 --- a/doc/SubstObj.3 +++ b/doc/SubstObj.3 @@ -24,7 +24,7 @@ message. .AP Tcl_Obj *objPtr in A Tcl value containing the string to perform substitutions on. .AP int flags in -ORed combination of flag bits that specify which substitutions to +OR'ed combination of flag bits that specify which substitutions to perform. The flags \fBTCL_SUBST_COMMANDS\fR, \fBTCL_SUBST_VARIABLES\fR and \fBTCL_SUBST_BACKSLASHES\fR are currently supported, and \fBTCL_SUBST_ALL\fR is provided as a diff --git a/doc/TclZlib.3 b/doc/TclZlib.3 index bd37f9c507cf..619b2dc307cd 100644 --- a/doc/TclZlib.3 +++ b/doc/TclZlib.3 @@ -88,7 +88,7 @@ The initial value for the checksum algorithm. .AP "unsigned char" *bytes in An array of bytes to run the checksum algorithm over, or NULL to get the recommended initial value for the checksum algorithm. -.AP size_t length in +.AP Tcl_Size length in The number of bytes in the array. .AP int mode in What mode to operate the stream in. Should be either @@ -107,8 +107,8 @@ if the currently compressed data must be made available for access using into a state where the decompressor can recover from on corruption, or \fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any trailer demanded by the format is written. -.AP size_t count in -The maximum number of bytes to get from the stream, or TCL_INDEX_NONE to get +.AP Tcl_Size count in +The maximum number of bytes to get from the stream, or -1 to get all remaining bytes from the stream's buffers. .AP Tcl_Obj *compDict in A byte array value that is the compression dictionary to use with the stream. diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index c2087110a858..8277262dbd23 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -29,7 +29,7 @@ Tcl_Obj * \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc -.AP size_t argc in +.AP Tcl_Size argc in Number of elements in \fIargv\fR. .AP char *argv[] in Array of strings containing command-line arguments. On Windows, when diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index 86d2f989c680..089e1202ff0b 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -22,13 +22,13 @@ int int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp -size_t +Tcl_Size \fBTcl_UtfToUpper\fR(\fIstr\fR) .sp -size_t +Tcl_Size \fBTcl_UtfToLower\fR(\fIstr\fR) .sp -size_t +Tcl_Size \fBTcl_UtfToTitle\fR(\fIstr\fR) .SH ARGUMENTS .AS char *str in/out diff --git a/doc/Translate.3 b/doc/Translate.3 index 256baecf9806..e7668ebe005e 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -21,8 +21,7 @@ char * .AP Tcl_Interp *interp in Interpreter in which to report an error, if any. .AP "const char" *name in -File name, which may start with a -.QW ~ . +File name .AP Tcl_DString *bufferPtr in/out If needed, this dynamic string is used to store the new file name. At the time of the call it should be uninitialized or free. The diff --git a/doc/Utf.3 b/doc/Utf.3 index 31cc333c24bc..5f75a3e0eddd 100644 --- a/doc/Utf.3 +++ b/doc/Utf.3 @@ -15,16 +15,16 @@ Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar .sp typedef ... \fBTcl_UniChar\fR; .sp -size_t +Tcl_Size \fBTcl_UniCharToUtf\fR(\fIch, buf\fR) .sp -size_t +Tcl_Size \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp -size_t +Tcl_Size \fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR) .sp -size_t +Tcl_Size \fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR) .sp char * @@ -93,7 +93,7 @@ int const char * \fBTcl_UtfAtIndex\fR(\fIsrc, index\fR) .sp -size_t +Tcl_Size \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out @@ -132,16 +132,16 @@ A null-terminated utf-16 string. A null-terminated utf-16 string. .AP "const unsigned short" *utf16Pattern in A null-terminated utf-16 string. -.AP size_t length in +.AP Tcl_Size length in The length of the UTF-8 string in bytes (not UTF-8 characters). If -TCL_INDEX_NONE, all bytes up to the first null byte are used. -.AP size_t uniLength in +negative, all bytes up to the first null byte are used. +.AP Tcl_Size uniLength in The length of the Unicode string in characters. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. -.AP size_t index in +.AP Tcl_Size index in The index of a character (not byte) in the UTF-8 string. .AP int *readPtr out If non-NULL, filled with the number of bytes in the backslash sequence, @@ -254,7 +254,7 @@ know if a full Unicode character has been seen. \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It returns the number of Tcl_UniChars that are represented by the UTF-8 string \fIsrc\fR. The length of the source string is \fIlength\fR bytes. If the -length is TCL_INDEX_NONE, all bytes up to the first null byte are used. +length is negative, all bytes up to the first null byte are used. .PP \fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It returns a pointer to the first occurrence of the Unicode character \fIch\fR @@ -299,13 +299,13 @@ byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte Pascal Ord() function. It returns the Unicode character represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR -characters. If \fIindex\fR is TCL_INDEX_NONE or \fIindex\fR points +characters. If \fIindex\fR is negative or \fIindex\fR points to the second half of a surrogate pair, it returns -1. .PP \fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. This is equivalent to calling -\fBTcl_UtfToUniChar\fR \fIindex\fR times. If \fIindex\fR is TCL_INDEX_NONE, +\fBTcl_UtfToUniChar\fR \fIindex\fR times. If \fIindex\fR is negative, the return pointer points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3 index b501d36d6436..0d00c0b3a477 100644 --- a/doc/WrongNumArgs.3 +++ b/doc/WrongNumArgs.3 @@ -19,7 +19,7 @@ Tcl_WrongNumArgs \- generate standard error message for wrong number of argument .AP Tcl_Interp interp in Interpreter in which error will be reported: error message gets stored in its result value. -.AP size_t objc in +.AP Tcl_Size objc in Number of leading arguments from \fIobjv\fR to include in error message. .AP "Tcl_Obj *const" objv[] in diff --git a/doc/cd.n b/doc/cd.n index 4cd4792cc48a..c6d8527a51e2 100644 --- a/doc/cd.n +++ b/doc/cd.n @@ -28,7 +28,7 @@ and all threads. Change to the home directory of the user \fBfred\fR: .PP .CS -\fBcd\fR ~fred +\fBcd\fR [file home fred] .CE .PP Change to the directory \fBlib\fR that is a sibling directory of the diff --git a/doc/chan.n b/doc/chan.n index e8601f6c0eec..62121d14fa35 100644 --- a/doc/chan.n +++ b/doc/chan.n @@ -124,18 +124,8 @@ returned by \fBencoding names\fR, or from Unicode to the encoding. .RS .PP -\fBbinary\fR is an alias for \fBiso8859-1\fR: Each byte read from the -channel becomes the Unicode character having the same value as that byte, and -each character written to the channel becomes a single byte in the output, -allowing Tcl to work seamlessly with binary data as long as each "character" in -the data remains in the range of 0 to 255 so that there is no distinction between -binary data and text. For example, A JPEG image can be read from a -\fBbinary\fR channel, manipulated, and then written back to a \fBbinary\fR -channel. - -For working with binary data \fB\-translation binary\fR is usually used -instead, as it sets the encoding to \fBbinary\fR and also disables other -translations on the channel. +\fBbinary\fR is an alias for \fBiso8859-1\fR. This alone is not sufficient for +working with binary data. Use \fB\-translation binary\fR instead. .PP The encoding of a new channel is the value of \fBencoding system\fR, which returns the platform- and locale-dependent system encoding used to @@ -196,10 +186,17 @@ platforms it is \fBcrlf\fR for both input and output. .TP \fBbinary\fR . -Like \fBlf\fR, no end-of-line translation is performed, but in addition, -\fB\-eofchar\fR is set to the empty string to disable it, and \fB\-encoding\fR -is set to \fBbinary\fR. With this one setting, a channel is fully configured -for binary input and output. +Like \fBlf\fR, no end-of-line translation is performed, but in addition, sets +\fB\-eofchar\fR to the empty string to disable it, sets \fB\-encoding\fR to +\fBiso8859-1\fR, and sets \fB-profile\fR to \fBstrict\fR so the the channel is +fully configured for binary input and output: Each byte read from the channel +becomes the Unicode character having the same value as that byte, and each +character written to the channel becomes a single byte in the output. This +makes it possible to work seamlessly with binary data as long as each character +in the data remains in the range of 0 to 255 so that there is no distinction +between binary data and text. For example, A JPEG image can be read from a +such a channel, manipulated, and then written back to such a channel. + .TP \fBcr\fR . @@ -226,50 +223,119 @@ typically used on UNIX platforms, .TP \fBchan copy \fIinputChan outputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? . -Copies data from \fIinputChan\fR to \fIoutputChan\fR, leveraging internal -buffers to avoid extra copies and to avoid buffering too much data in main -memory when copying large files to slow destinations like network sockets. +Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until +all characters are copied, blocking until the copy is complete and returning +the number of characters copied. Leverages internal buffers to avoid extra +copies and to avoid buffering too much data in main memory when copying large +files to slow destinations like network sockets. .RS .PP -If \fB\-size\fR is given, the size is in bytes if the two channels have the -same encoding and in characters otherwise, and only that amount is copied. -Otherwise, all data until the end of the file is copied. - -\fBchan copy\fR blocks until the copy is complete and returns the number of -bytes or characters written to \fIoutputChan\fR. -.PP -If \fB\-command\fR is given, \fBchan copy\fR returns immediately, the copy is -carried out in the background, and then \fIcallback\fR is called with the -number of bytes written to \fIoutputChan\fR as its first argument, and the -error message for any error that occurred as its second argument. -\fIinputChan\fR and \fIoutputChan\fR are automatically configured for -non-blocking mode if needed. Background copying only works correctly if the -event loop is active, e.g. via \fBvwait\fR or Tk. -.PP -During a background copy no other read or write operation may be performed on -\fIinputChan\fR or \fIoutputChan\fR. If either \fIinputChan\fR or -\fIoutputChan\fR is closed while the copy is in progress copying ceases and -\fBno\fR callback is made. If \fIinputChan\fR is closed all data already queued -is written to \fIoutputChan\fR. -.PP -The should be no event handler established for \fIinputChan\fR because it may -become readable during a background copy. An attempt to read or write -from within an event handler results result in the error, "channel busy". -.PP -Due to end-of-line translation the number of bytes read from \fIinputChan\fR -may be different than the number of bytes written to \fIoutputChan\fR. Only -the number of bytes written to \fIoutputChan\fR is reported. -.PP -\fBChan copy\fR reads the data according to the \fB\-encoding\fR, -\fB\-translation\fR, and \fB\-eofchar\fR of the source and writes to the -destination according to the configuration for that channel. If the encoding -and translation of both channels is \fBbinary\fR and the \fB\-eofchar\fR of -both channels is the empty string, an identical copy is made. If only the -encoding of the destination is \fBbinary\fR, Tcl's internal modified UTF-8 -representation of the characters read from the source is written to the -destination. If only the encoding of the source is \fBbinary\fR, each byte read -becomes one Unicode character in the range of 0 to 255, and that character is -subject to the encoding and translation of the destination as it is written. +\fB\-size\fR limits the number of characters copied. +.PP +If \fB\-command\fR is gviven, \fBchan copy\fR returns immediately, works in the +background, and calls \fIcallback\fR when the copy completes, providing as an +additional argument the number of characters written to \fIoutputChan\fR. If +an error occurres during the background copy, another argument provides message +for the error. \fIinputChan\fR and \fIoutputChan\fR are automatically +configured for non-blocking mode if needed. Background copying only works +correctly if events are being processed, e.g. via \fBvwait\fR or Tk. +.PP +During a background copy no other read operation may be performed on +\fIinputChan\fR, and no write operation may be performed on +\fIoutputChan\fR. However, write operations may by performed on +\fIinputChan\fR and read operations may be performed on \fIoutputChan\fR, as +exhibited by the bidirectional copy example below. +.PP +If either \fIinputChan\fR or \fIoutputChan\fR is closed while the copy is in +progress, copying ceases and \fBno\fR callback is made. If \fIinputChan\fR is +closed all data already queued is written to \fIoutputChan\fR. +.PP +There should be no event handler established for \fIinputChan\fR because it +may become readable during a background copy. An attempt to read or write from +within an event handler results result in the error, "channel busy". Any +wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results +in a +.QW "channel busy" +error. +.PP +.PP +.IP \fBEXAMPLES\fR +.PP +The first example transfers the contents of one channel exactly to +another. Note that when copying one file to another, it is better to +use \fBfile copy\fR which also copies file metadata (e.g. the file +access permissions) where possible. +.PP +.CS +fconfigure $in -translation binary +fconfigure $out -translation binary +\fBfcopy\fR $in $out +.CE +.PP +This second example shows how the callback gets +passed the number of bytes transferred. +It also uses vwait to put the application into the event loop. +Of course, this simplified example could be done without the command +callback. +.PP +.CS +proc Cleanup {in out bytes {error {}}} { + global total + set total $bytes + close $in + close $out + if {[string length $error] != 0} { + # error occurred during the copy + } +} +set in [open $file1] +set out [socket $server $port] +\fBfcopy\fR $in $out -command [list Cleanup $in $out] +vwait total +.CE +.PP +The third example copies in chunks and tests for end of file +in the command callback. +.PP +.CS +proc CopyMore {in out chunk bytes {error {}}} { + global total done + incr total $bytes + if {([string length $error] != 0) || [eof $in]} { + set done $total + close $in + close $out + } else { + \fBfcopy\fR $in $out -size $chunk \e + -command [list CopyMore $in $out $chunk] + } +} +set in [open $file1] +set out [socket $server $port] +set chunk 1024 +set total 0 +\fBfcopy\fR $in $out -size $chunk \e + -command [list CopyMore $in $out $chunk] +vwait done +.CE +.PP +The fourth example starts an asynchronous, bidirectional fcopy between +two sockets. Those could also be pipes from two [open "|hal 9000" r+] +(though their conversation would remain secret to the script, since +all four fileevent slots are busy). +.PP +.CS +set flows 2 +proc Done {dir args} { + global flows done + puts "$dir is over." + incr flows -1 + if {$flows<=0} {set done 1} +} +\fBfcopy\fR $sok1 $sok2 -command [list Done UP] +\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN] +vwait done +.CE .RE .TP \fBchan create \fImode cmdPrefix\fR diff --git a/doc/cookiejar.n b/doc/cookiejar.n index 7d2f46bc75e2..1391e014c6ca 100644 --- a/doc/cookiejar.n +++ b/doc/cookiejar.n @@ -178,7 +178,7 @@ the start of the application. package require http \fBpackage require cookiejar\fR -set cookiedb ~/.tclcookies.db +set cookiedb [file join [file home] cookiejar] http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb] # No further explicit steps are required to use cookies @@ -201,7 +201,7 @@ oo::class create MyCookieJar { } } -set cookiedb ~/.tclcookies.db +set cookiedb [file join [file home] cookiejar] http::configure -cookiejar [MyCookieJar new $cookiedb] # No further explicit steps are required to use cookies diff --git a/doc/encoding.n b/doc/encoding.n index 8ede97499671..793348fd9be0 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -1,5 +1,6 @@ '\" '\" Copyright (c) 1998 Scriptics Corporation. +'\" Copyright (c) 2023 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -8,78 +9,81 @@ .so man.macros .BS .SH NAME -encoding \- Manipulate encodings +encoding \- Work with encodings .SH SYNOPSIS -\fBencoding \fIoption\fR ?\fIarg arg ...\fR? +\fBencoding \fIoperation\fR ?\fIarg arg ...\fR? .BE .SH INTRODUCTION .PP -Strings in Tcl are logically a sequence of Unicode characters. -These strings are represented in memory as a sequence of bytes that -may be in one of several encodings: modified UTF\-8 (which uses 1 to 4 -bytes per character), or a custom encoding start as 8 bit binary data. -.PP -Different operating system interfaces or applications may generate -strings in other encodings such as Shift\-JIS. The \fBencoding\fR -command helps to bridge the gap between Unicode and these other -formats. +In Tcl every string is composed of Unicode values. Text may be encoded into an +encoding such as cp1252, iso8859-1, Shitf\-JIS, utf-8, utf-16, etc. Not every +Unicode vealue is encodable in every encoding, and some encodings can encode +values that are not available in Unicode. +.PP +Even though Unicode is for encoding the written texts of human languages, any +sequence of bytes can be encoded as the first 255 Unicode values. iso8859-1 an +encoding for a subset of Unicode in which each byte is a Unicode value of 255 +or less. Thus, any sequence of bytes can be considered to be a Unicode string +encoded in iso8859-1. To work with binary data in Tcl, decode it from +iso8859-1 when reading it in, and encode it into iso8859-1 when writing it out, +ensuring that each character in the string has a value of 255 or less. +Decoding such a string does nothing, and encoding encoding such a string also +does nothing. +.PP +For example, the following is true: +.CS +set text {In Tcl binary data is treated as Unicode text and it just works.} +set encoded [encoding convertto iso8859-1 $text] +expr {$text eq $encoded}; #-> 1 +.CE +The following is also true: +.CS +set decoded [encoding convertfrom iso8859-1 $text] +expr {$text eq $decoded}; #-> 1 +.CE .SH DESCRIPTION .PP -Performs one of several encoding related operations, depending on -\fIoption\fR. The legal \fIoption\fRs are: +Performs one of the following encoding \fIoperations\fR: .TP \fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR .TP \fBencoding convertfrom\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding\fR \fIdata\fR . -Converts \fIdata\fR, which should be in binary string encoded as per -\fIencoding\fR, to a Tcl string. If \fIencoding\fR is not specified, the current -system encoding is used. +Decodes \fIdata\fR encoded in \fIencoding\fR. If \fIencoding\fR is not +specified the current system encoding is used. .VS "TCL8.7 TIP607, TIP656" -The \fB-profile\fR option determines the command behavior in the presence -of conversion errors. See the \fBPROFILES\fR section below for details. Any premature -termination of processing due to errors is reported through an exception if -the \fB-failindex\fR option is not specified. - -If the \fB-failindex\fR is specified, instead of an exception being raised -on premature termination, the result of the conversion up to the point of the -error is returned as the result of the command. In addition, the index -of the source byte triggering the error is stored in \fBvar\fR. If no -errors are encountered, the entire result of the conversion is returned and -the value \fB-1\fR is stored in \fBvar\fR. +\fB-profile\fR determines how invalid data for the encoding are handled. See +the \fBPROFILES\fR section below for details. Returns an error if decoding +fails. However, if \fB-failindex\fR given, returns the result of the +conversion up to the point of termination, and stores in \fBvar\fR the index of +the character that could not be converted. If no errors are encountered the +entire result of the conversion is returned and the value \fB-1\fR is stored in +\fBvar\fR. .VE "TCL8.7 TIP607, TIP656" .TP \fBencoding convertto\fR ?\fIencoding\fR? \fIdata\fR .TP \fBencoding convertto\fR ?\fB-profile \fIprofile\fR? ?\fB-failindex var\fR? \fIencoding\fR \fIdata\fR . -Convert \fIstring\fR to the specified \fIencoding\fR. The result is a Tcl binary -string that contains the sequence of bytes representing the converted string in -the specified encoding. If \fIencoding\fR is not specified, the current system -encoding is used. +Converts \fIstring\fR to \fIencoding\fR. If \fIencoding\fR is not given, the +current system encoding is used. .VS "TCL8.7 TIP607, TIP656" -The \fB-profile\fR and \fB-failindex\fR options have the same effect as -described for the \fBencoding convertfrom\fR command. +See \fBencoding convertfrom\fR for the meaning of \fB-profile\fR and \fB-failindex\fR. .VE "TCL8.7 TIP607, TIP656" .TP \fBencoding dirs\fR ?\fIdirectoryList\fR? . -Tcl can load encoding data files from the file system that describe -additional encodings for it to work with. This command sets the search -path for \fB*.enc\fR encoding data files to the list of directories -\fIdirectoryList\fR. If \fIdirectoryList\fR is omitted then the -command returns the current list of directories that make up the -search path. It is an error for \fIdirectoryList\fR to not be a valid -list. If, when a search for an encoding data file is happening, an -element in \fIdirectoryList\fR does not refer to a readable, -searchable directory, that element is ignored. +Sets the search path for \fB*.enc\fR encoding data files to the list of +directories given by \fIdirectoryList\fR. If \fIdirectoryList\fR is not given, +returns the current list of directories that make up the search path. It is +not an error for an item in \fIdirectoryList\fR to not refer to a readable, +searchable directory. .TP \fBencoding names\fR . -Returns a list containing the names of all of the encodings that are -currently available. +Returns a list of the names of available encodings. The encodings .QW utf-8 and @@ -88,103 +92,73 @@ are guaranteed to be present in the list. .VS "TCL8.7 TIP656" .TP \fBencoding profiles\fR -Returns a list of the names of encoding profiles. See \fBPROFILES\fR below. +Returns a list of names of available encoding profiles. See \fBPROFILES\fR +below. .VE "TCL8.7 TIP656" .TP \fBencoding system\fR ?\fIencoding\fR? . -Set the system encoding to \fIencoding\fR. If \fIencoding\fR is -omitted then the command returns the current system encoding. The -system encoding is used whenever Tcl passes strings to system calls. -\" Do not put .VS on whole section as that messes up the bullet list alignment +Sets the system encoding to \fIencoding\fR. If \fIencoding\fR is not given, +returns the current system encoding. The system encoding is used to pass +strings to system calls. +.\" Do not put .VS on whole section as that messes up the bullet list alignment .SH PROFILES .PP .VS "TCL8.7 TIP656" -Operations involving encoding transforms may encounter several types of -errors such as invalid sequences in the source data, characters that -cannot be encoded in the target encoding and so on. -A \fIprofile\fR prescribes the strategy for dealing with such errors -in one of two ways: -.VE "TCL8.7 TIP656" -. -.IP \(bu -.VS "TCL8.7 TIP656" -Terminating further processing of the source data. The profile does not -determine how this premature termination is conveyed to the caller. By default, -this is signalled by raising an exception. If the \fB-failindex\fR option -is specified, errors are reported through that mechanism. -.VE "TCL8.7 TIP656" -.IP \(bu -.VS "TCL8.7 TIP656" -Continue further processing of the source data using a fallback strategy such -as replacing or discarding the offending bytes in a profile-defined manner. -.VE "TCL8.7 TIP656" +Each \fIprofile\fR is a distinct strategy for dealing with invalid data for an +encoding. .PP -The following profiles are currently implemented with \fBtcl8\fR being -the default if the \fB-profile\fR is not specified. +The following profiles are currently implemented. .VS "TCL8.7 TIP656" .TP \fBtcl8\fR . -The \fBtcl8\fR profile always follows the first strategy above and corresponds -to the behavior of encoding transforms in Tcl 8.6. When converting from an -external encoding \fBother than utf-8\fR to Tcl strings with the \fBencoding -convertfrom\fR command, invalid bytes are mapped to their numerically equivalent -code points. For example, the byte 0x80 which is invalid in ASCII would be -mapped to code point U+0080. When converting from \fButf-8\fR, invalid bytes -that are defined in CP1252 are mapped to their Unicode equivalents while those -that are not fall back to the numerical equivalents. For example, byte 0x80 is -defined by CP1252 and is therefore mapped to its Unicode equivalent U+20AC while -byte 0x81 which is not defined by CP1252 is mapped to U+0081. As an additional -special case, the sequence 0xC0 0x80 is mapped to U+0000. +The default profile. Provides for behaviour identical to that of Tcl 8.6: When +decoding, for encodings \fBother than utf-8\fR, each invalid byte is interpreted +as the Unicode value given by that one byte. For example, the byte 0x80, which +is invalid in the ASCII encoding would be mapped to the Unicode value U+0080. +For \fButf-8\fR, each invalid byte that is a valid CP1252 character is +interpreted as the Unicode value for that character, while each byte that is +not is treated as the Unicode value given by that one byte. For example, byte +0x80 is defined by CP1252 and is therefore mapped to its Unicode equivalent +U+20AC while byte 0x81 which is not defined by CP1252 is mapped to U+0081. As +an additional special case, the sequence 0xC0 0x80 is mapped to U+0000. -When converting from Tcl strings to an external encoding format using -\fBencoding convertto\fR, characters that cannot be represented in the -target encoding are replaced by an encoding-dependent character, usually -the question mark \fB?\fR. +When encoding, each character that cannot be represented in the encoding is +replaced by an encoding-dependent character, usually the question mark \fB?\fR. .TP \fBstrict\fR . -The \fBstrict\fR profile always stops processing when an conversion error is -encountered. The error is signalled via an exception or the \fB-failindex\fR -option mechanism. The \fBstrict\fR profile implements a Unicode standard -conformant behavior. +The operation fails when invalid data for the encoding are encountered. .TP \fBreplace\fR . -Like the \fBtcl8\fR profile, the \fBreplace\fR profile always continues -processing on conversion errors but follows a Unicode standard conformant -method for substitution of invalid source data. +When decoding, invalid bytes are replaced by U+FFFD, the Unicode REPLACEMENT +CHARACTER. -When converting an encoded byte sequence to a Tcl string using -\fBencoding convertfrom\fR, invalid bytes -are replaced by the U+FFFD REPLACEMENT CHARACTER code point. - -When encoding a Tcl string with \fBencoding convertto\fR, -code points that cannot be represented in the -target encoding are transformed to an encoding-specific fallback character, -U+FFFD REPLACEMENT CHARACTER for UTF targets and generally `?` for other -encodings. +When encoding, Unicode values that cannot be represented in the target encoding +are transformed to an encoding-specific fallback character, U+FFFD REPLACEMENT +CHARACTER for UTF targets, and generally `?` for other encodings. .VE "TCL8.7 TIP656" .SH EXAMPLES .PP -These examples use the utility proc below that prints the Unicode code points -comprising a Tcl string. +These examples use the utility proc below that prints the Unicode value for +each character in a string. .PP .CS -proc codepoints {s} {join [lmap c [split $s ""] { +proc codepoints s {join [lmap c [split $s {}] { string cat U+ [format %.6X [scan $c %c]]}] } .CE .PP -Example 1: convert a byte sequence in Japanese euc-jp encoding to a TCL string: +Example 1: Convert from euc-jp: .PP .CS -% codepoints [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"] +% codepoints [\fBencoding convertfrom\fR euc-jp \exA4\exCF] U+00306F .CE .PP -The result is the unicode codepoint +The result is the Unicode value .QW "\eu306F" , which is the Hiragana letter HA. .VS "TCL8.7 TIP607, TIP656" @@ -193,8 +167,8 @@ Example 2: Error handling based on profiles: .PP The letter \fBA\fR is Unicode character U+0041 and the byte "\ex80" is invalid in ASCII encoding. -.CS .PP +.CS % codepoints [encoding convertfrom -profile tcl8 ascii A\ex80] U+000041 U+000080 % codepoints [encoding convertfrom -profile replace ascii A\ex80] diff --git a/doc/exec.n b/doc/exec.n index 1f878188b0f6..9421eb18536c 100644 --- a/doc/exec.n +++ b/doc/exec.n @@ -449,7 +449,7 @@ encrypted so that only the current user can access it requires use of the \fICIPHER\fR command, like this: .PP .CS -set secureDir "~/Desktop/Secure Directory" +set secureDir [file join [file home] Desktop/SecureDirectory] file mkdir $secureDir \fBexec\fR CIPHER /e /s:[file nativename $secureDir] .CE diff --git a/doc/fcopy.n b/doc/fcopy.n index 477f242f3499..b04389871de1 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -12,90 +12,44 @@ .SH NAME fcopy \- Copy data from one channel to another .SH SYNOPSIS -\fBfcopy \fIinchan\fR \fIoutchan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? +\fBfcopy \fIinputChan\fR \fIoutputChan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR? .BE .SH DESCRIPTION .PP -The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR. -The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to -avoid extra copies and to avoid buffering too much data in -main memory when copying large files to slow destinations like -network sockets. -.PP -The \fBfcopy\fR -command transfers data from \fIinchan\fR until end of file -or \fIsize\fR bytes or characters have been -transferred; \fIsize\fR is in bytes if the input channel is in binary mode, -and is in characters otherwise. -If no \fB\-size\fR argument is given, -then the copy goes until end of file. -All the data read from \fIinchan\fR is copied to \fIoutchan\fR. -Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete -and returns the number of bytes or characters (using the same rules as -for the \fB\-size\fR option) written to \fIoutchan\fR. -.PP -The \fB\-command\fR argument makes \fBfcopy\fR work in the background. -In this case it returns immediately and the \fIcallback\fR is invoked -later when the copy completes. -The \fIcallback\fR is called with -one or two additional -arguments that indicates how many bytes were written to \fIoutchan\fR. -If an error occurred during the background copy, the second argument is the -error string associated with the error. -With a background copy, -it is not necessary to put \fIinchan\fR or \fIoutchan\fR into -non-blocking mode; the \fBfcopy\fR command takes care of that automatically. -However, it is necessary to enter the event loop by using -the \fBvwait\fR command or by using Tk. -.PP -You are not allowed to do other input operations with \fIinchan\fR, or -output operations with \fIoutchan\fR, during a background -\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the -bidirectional fcopy example below. -.PP -If either \fIinchan\fR or \fIoutchan\fR get closed -while the copy is in progress, the current copy is stopped -and the command callback is \fInot\fR made. -If \fIinchan\fR is closed, -then all data already queued for \fIoutchan\fR is written out. -.PP -Note that \fIinchan\fR can become readable during a background copy. -You should turn off any \fBfileevent\fR handlers during a background -copy so those handlers do not interfere with the copy. -Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a +Reads characters from \fIinputChan\fR and writes them to \fIoutputChan\fR until +all characters are copied, blocking until the copy is complete and returning +the number of characters copied. Leverages internal buffers to avoid extra +copies and to avoid buffering too much data in main memory when copying large +files to slow destinations like network sockets. +.PP +\fB\-size\fR limits the number of characters copied. +.PP +\fB\-command\fR makes \fBfcopy\fR return immediately, work in the background, +and call \fIcallback\fR when the copy completes, providing as an additional +argument the number of characters written to \fIoutputChan\fR. If an error +occurres during the background copy, another argument provides the message for +the error. \fIinputChan\fR and \fIoutputChan\fR are automatically configured +for non-blocking mode if needed. Background copying only works correctly if +events are being processed e.g. via \fBvwait\fR or Tk. +.PP +During a background copy no other read operation may be performed on +\fIinputChan\fR, and no other write operation may be performed on +\fIoutputChan\fR. However, write operations may by performed on +\fIinputChan\fR and read operations may be performed on \fIoutputChan\fR, as +exhibited by the bidirectional copy example below. +.PP +If either \fIinputChan\fR or \fIoutputChan\fR is closed while the copy is in +progress, copying ceases and \fBno\fR callback is made. If \fIinputChan\fR is +closed all data already queued is written to \fIoutputChan\fR. +.PP +There should be no event handler established for \fIinputChan\fR because it +may become readable during a background copy. An attempt to read or write from +within an event handler results result in the error, "channel busy". Any +wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) results +in a .QW "channel busy" error. -.PP -\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR -according to the \fB\-translation\fR option -for these channels. -See the manual entry for \fBfconfigure\fR for details on the -\fB\-translation\fR option. -The translations mean that the number of bytes read from \fIinchan\fR -can be different than the number of bytes written to \fIoutchan\fR. -Only the number of bytes written to \fIoutchan\fR is reported, -either as the return value of a synchronous \fBfcopy\fR or -as the argument to the callback for an asynchronous \fBfcopy\fR. -.PP -\fBFcopy\fR obeys the encodings and character translations configured -for the channels. This -means that the incoming characters are converted internally first -UTF-8 and then into the encoding of the channel \fBfcopy\fR writes -to. See the manual entry for \fBfconfigure\fR for details on the -\fB\-encoding\fR and \fB\-translation\fR options. No conversion is -done if both channels are -set to encoding -.QW binary -and have matching translations. If only the output channel is set to encoding -.QW binary -the system will write the internal UTF-8 representation of the incoming -characters. If only the input channel is set to encoding -.QW binary -the system will assume that the incoming -bytes are valid UTF-8 characters and convert them according to the -output encoding. The behaviour of the system for bytes which are not -valid UTF-8 characters is undefined in this case. .SH EXAMPLES .PP The first example transfers the contents of one channel exactly to @@ -144,7 +98,7 @@ proc CopyMore {in out chunk bytes {error {}}} { close $out } else { \fBfcopy\fR $in $out -size $chunk \e - -command [list CopyMore $in $out $chunk] + -command [list CopyMore $in $out $chunk] } } set in [open $file1] @@ -152,7 +106,7 @@ set out [socket $server $port] set chunk 1024 set total 0 \fBfcopy\fR $in $out -size $chunk \e - -command [list CopyMore $in $out $chunk] + -command [list CopyMore $in $out $chunk] vwait done .CE .PP diff --git a/doc/file.n b/doc/file.n index 5a064afba7a3..ff581c919ae0 100644 --- a/doc/file.n +++ b/doc/file.n @@ -242,10 +242,7 @@ must be relative to the actual \fIlinkName\fR's location (not to the cwd), but on all other platforms where relative links are not supported, target paths will always be converted to absolute, normalized form before the link is created (and therefore relative paths are interpreted -as relative to the cwd). Furthermore, -.QW ~user -paths are always expanded -to absolute form. When creating links on filesystems that either do not +as relative to the cwd). When creating links on filesystems that either do not support any links, or do not support the specific type requested, an error message will be returned. Most Unix platforms support both symbolic and hard links (the latter for files only). Windows @@ -571,7 +568,7 @@ interface) but the name passed to the operating system must be in native format: .PP .CS -exec {*}[auto_execok start] {} [\fBfile nativename\fR ~/example.txt] +exec {*}[auto_execok start] {} [\fBfile nativename\fR C:/Users/fred/example.txt] .CE .SH "SEE ALSO" filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n), diff --git a/doc/glob.n b/doc/glob.n index 80610f79c70b..b19e47ff3727 100644 --- a/doc/glob.n +++ b/doc/glob.n @@ -72,7 +72,7 @@ is equivalent to .QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" . For \fB\-path\fR specifications, the returned names will include the last path segment, so -.QW "\fBglob \-tails \-path [file rootname ~/foo.tex] .*\fR" +.QW "\fBglob \-tails \-path [file rootname /home/fred/foo.tex] .*\fR" will return paths like \fBfoo.aux foo.bib foo.tex\fR etc. .TP \fB\-types\fR \fItypeList\fR @@ -168,16 +168,6 @@ which must be matched explicitly (this is to avoid a recursive pattern like from recursing up the directory hierarchy as well as down). In addition, all .QW / characters must be matched explicitly. -.LP -If the first character in a \fIpattern\fR is -.QW ~ -then it refers to the home directory for the user whose name follows the -.QW ~ . -If the -.QW ~ -is followed immediately by -.QW / -then the value of the HOME environment variable is used. .PP The \fBglob\fR command differs from csh globbing in two ways. First, it does not sort its result list (use the \fBlsort\fR @@ -188,13 +178,7 @@ contains a ?, *, or [] construct. .SH "WINDOWS PORTABILITY ISSUES" .PP For Windows UNC names, the servername and sharename components of the path -may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is -of the form -.QW \fB~\fIusername\fB@\fIdomain\fR , -it refers to the home -directory of the user whose account information resides on the specified NT -domain server. Otherwise, user account information is obtained from -the local computer. +may not contain ?, *, or [] constructs. .PP Since the backslash character has a special meaning to the glob command, glob patterns containing Windows style path separators need @@ -229,7 +213,7 @@ Find all the Tcl files in the user's home directory, irrespective of what the current directory is: .PP .CS -\fBglob\fR \-directory ~ *.tcl +\fBglob\fR \-directory [file home] *.tcl .CE .PP Find all subdirectories of the current directory: diff --git a/doc/info.n b/doc/info.n index 86263db53f7e..8a61ba91a0c5 100644 --- a/doc/info.n +++ b/doc/info.n @@ -172,7 +172,7 @@ The body of a script provided to \fBeval\fR or \fBuplevel\fR. .TP \fBprecompiled\fR\0\0\0\0\0\0\0\0 . -A pre-compiled script (loadable by the package +A precompiled script (loadable by the package \fBtbcload\fR), and no further information is available. .RE .TP diff --git a/doc/memory.n b/doc/memory.n index dc585027d765..7a6922112019 100644 --- a/doc/memory.n +++ b/doc/memory.n @@ -41,7 +41,7 @@ of packets and bytes allocated. .TP \fBmemory init \fR[\fBon\fR|\fBoff\fR] . -Turn on or off the pre-initialization of all allocated memory +Turn on or off the preinitialization of all allocated memory with bogus bytes. Useful for detecting the use of uninitialized values. .TP diff --git a/doc/namespace.n b/doc/namespace.n index 3196cacb07dd..1773555ed1fa 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -161,7 +161,7 @@ this command first finds the matching exported commands. It then checks whether any of those commands were previously imported by the current namespace. If so, this command deletes the corresponding imported commands. -In effect, this un-does the action of a \fBnamespace import\fR command. +In effect, this undoes the action of a \fBnamespace import\fR command. .TP \fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR? . diff --git a/doc/next.n b/doc/next.n index f731335f0fdc..624e058f9d50 100644 --- a/doc/next.n +++ b/doc/next.n @@ -96,7 +96,7 @@ forward to the proper implementation of the method (which it does by invoking the \fBnext\fR command as filters are inserted into the front of the method call chain) and is responsible for returning the result of \fBnext\fR. .PP -Filters are invoked when processing an invokation of the \fBunknown\fR +Filters are invoked when processing an invocation of the \fBunknown\fR method because of a failure to locate a method implementation, but \fInot\fR when invoking either constructors or destructors. (Note however that the \fBdestroy\fR method is a conventional method, and filters are invoked as diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n index 5a6b905a282a..f98cbcd86bf6 100644 --- a/doc/pkgMkIndex.n +++ b/doc/pkgMkIndex.n @@ -108,7 +108,7 @@ it immediately upon \fBpackage require\fR. This is not compatible with the use of \fIauto_reset\fR, and therefore its use is discouraged. .TP 15 \fB\-load \fIpkgPat\fR -The index process will pre-load any packages that exist in the +The index process will preload any packages that exist in the current interpreter and match \fIpkgPat\fR into the child interpreter used to generate the index. The pattern match uses string match rules, but without making case distinctions. diff --git a/doc/refchan.n b/doc/refchan.n index c17117d3fcab..ae900c500ff8 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -53,8 +53,8 @@ here, then the \fBfinalize\fR subcommand will not be called. .PP The \fImode\fR argument tells the handler whether the channel was opened for reading, writing, or both. It is a list containing any of -the strings \fBread\fR or \fBwrite\fR. The list will always -contain at least one element. +the strings \fBread\fR or \fBwrite\fR. The list may be empty, but +will usually contain at least one element. .PP The subcommand must throw an error if the chosen mode is not supported by the \fIcmdPrefix\fR. diff --git a/doc/tcltest.n b/doc/tcltest.n index 5a53699fe4b5..965ed6458155 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -625,14 +625,14 @@ the test suite is being run on a Unix platform. .PP Each \fBtest\fR should include whatever \fB\-constraints\fR are required to constrain it to run only where appropriate. Several -constraints are pre-defined in the \fBtcltest\fR package, listed +constraints are predefined in the \fBtcltest\fR package, listed below. The registration of user-defined constraints is performed by the \fBtestConstraint\fR command. User-defined constraints may appear within a test file, or within the script specified by the \fBconfigure \-load\fR or \fBconfigure \-loadfile\fR options. .PP -The following is a list of constraints pre-defined by the +The following is a list of constraints predefined by the \fBtcltest\fR package itself: .TP \fIsingleTestInterp\fR diff --git a/doc/tclvars.n b/doc/tclvars.n index 821447376436..d24495323fbc 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -73,11 +73,11 @@ The following elements of \fBenv\fR are special to Tcl: \fBenv(HOME)\fR . This environment variable, if set, gives the location of the directory -considered to be the current user's home directory, and to which a -call of \fBcd\fR without arguments or with just -.QW ~ -as an argument will change into. Most platforms set this correctly by -default; it does not normally need to be set by user code. +considered to be the current user's home directory. The value of this variable +is returned by the \fBfile home\fR command. Most platforms set this correctly by +default; it does not normally need to be set by user code. On Windows, if not +already set, it is set to the value of the \fBUSERPROFILE\fR environment +variable. .TP \fBenv(TCL_LIBRARY)\fR . diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 94a9f99f0ac9..535757119987 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -487,7 +487,7 @@ freearc( /* * changearctarget - flip an arc to have a different to state * - * Caller must have verified that there is no pre-existing duplicate arc. + * Caller must have verified that there is no preexisting duplicate arc. * * Note that because we store arcs in their from state, we can't easily have * a similar changearcsource function. @@ -1515,7 +1515,7 @@ pullback( * Returns 1 if successful (which it always is unless the source is the * start state or we have an internal error), 0 if nothing happened. * - * A significant property of this function is that it deletes no pre-existing + * A significant property of this function is that it deletes no preexisting * states, and no outarcs of the constraint's from state other than the given * constraint arc. This makes the loops in pullback() safe, at the cost that * we may leave useless states behind. Therefore, we leave it to pullback() @@ -1694,7 +1694,7 @@ pushfwd( * Returns 1 if successful (which it always is unless the destination is the * post state or we have an internal error), 0 if nothing happened. * - * A significant property of this function is that it deletes no pre-existing + * A significant property of this function is that it deletes no preexisting * states, and no inarcs of the constraint's to state other than the given * constraint arc. This makes the loops in pushfwd() safe, at the cost that * we may leave useless states behind. Therefore, we leave it to pushfwd() @@ -2467,7 +2467,7 @@ breakconstraintloop(struct nfa * nfa, struct state * sinitial) * have multiple redundant arc pathways). Each donemap is a char array * indexed by state number. The donemaps are all of the same size "nstates", * which is nfa->nstates as of the start of the recursion. This is enough to - * have entries for all pre-existing states, but *not* entries for clone + * have entries for all preexisting states, but *not* entries for clone * states created during the recursion. That's okay since we have no need to * mark those. * @@ -2774,7 +2774,7 @@ markcanreach( - analyze - ascertain potentially-useful facts about an optimized NFA ^ static long analyze(struct nfa *); */ -static long /* re_info bits to be ORed in */ +static long /* re_info bits to be OR'ed in */ analyze( struct nfa *nfa) { diff --git a/generic/regcomp.c b/generic/regcomp.c index 9ecc8c6ab54a..012e37cc8fcf 100644 --- a/generic/regcomp.c +++ b/generic/regcomp.c @@ -2184,9 +2184,9 @@ stid( return "unable"; } if (t->id != 0) { - sprintf(buf, "%d", t->id); + snprintf(buf, bufsize, "%d", t->id); } else { - sprintf(buf, "%p", t); + snprintf(buf, bufsize, "%p", t); } return buf; } diff --git a/generic/regerror.c b/generic/regerror.c index a53a0fd72928..5caab8ac56f5 100644 --- a/generic/regerror.c +++ b/generic/regerror.c @@ -73,7 +73,7 @@ regerror( break; } } - sprintf(convbuf, "%d", r->code); /* -1 for unknown */ + snprintf(convbuf, sizeof(convbuf), "%d", r->code); /* -1 for unknown */ msg = convbuf; break; case REG_ITOA: /* Convert number to name */ @@ -86,7 +86,7 @@ regerror( if (r->code >= 0) { msg = r->name; } else { /* Unknown; tell him the number */ - sprintf(convbuf, "REG_%u", icode); + snprintf(convbuf, sizeof(convbuf), "REG_%u", icode); msg = convbuf; } break; @@ -99,7 +99,7 @@ regerror( if (r->code >= 0) { msg = r->explain; } else { /* Unknown; say so */ - sprintf(convbuf, unk, code); + snprintf(convbuf, sizeof(convbuf), unk, code); msg = convbuf; } break; diff --git a/generic/regguts.h b/generic/regguts.h index b9af7acfb780..e135874734ea 100644 --- a/generic/regguts.h +++ b/generic/regguts.h @@ -258,10 +258,10 @@ struct state { }; struct nfa { - struct state *pre; /* pre-initial state */ + struct state *pre; /* preinitial state */ struct state *init; /* initial state */ struct state *final; /* final state */ - struct state *post; /* post-final state */ + struct state *post; /* postfinal state */ size_t nstates; /* for numbering states */ struct state *states; /* state-chain header */ struct state *slast; /* tail of the chain */ diff --git a/generic/tcl.decls b/generic/tcl.decls index e50e3de100fc..d52b7108ebd8 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -59,7 +59,7 @@ declare 8 { const char *file, int line) } -# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix, +# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on Unix, # but they are part of the old generic interface, so we include them here for # compatibility reasons. @@ -146,7 +146,7 @@ declare 32 { } # Only available in Tcl 8.x, NULL in Tcl 9.0 declare 33 { - unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr) + unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, void *numBytesPtr) } declare 34 { int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr) @@ -173,7 +173,7 @@ declare 40 { const Tcl_ObjType *Tcl_GetObjType(const char *typeName) } declare 41 { - char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr) + char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr) } declare 42 { void Tcl_InvalidateStringRep(Tcl_Obj *objPtr) @@ -188,7 +188,7 @@ declare 44 { } declare 45 { int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *objcPtr, Tcl_Obj ***objvPtr) + void *objcPtr, Tcl_Obj ***objvPtr) } declare 46 { int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, @@ -196,7 +196,7 @@ declare 46 { } declare 47 { int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *lengthPtr) + void *lengthPtr) } declare 48 { int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, @@ -881,12 +881,12 @@ declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { - int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, + int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) + void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) } # Removed in 9.0 (stub entry only) #declare 244 { @@ -1601,7 +1601,7 @@ declare 433 { # introduced in 8.4a3 declare 434 { - Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr) + Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, void *lengthPtr) } # TIP#15 (math function introspection) dkf @@ -1702,7 +1702,7 @@ declare 460 { Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements) } declare 461 { - Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) + Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) } declare 462 { int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr) @@ -1841,7 +1841,7 @@ declare 496 { Tcl_Obj *keyPtr) } declare 497 { - int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr) + int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr) } declare 498 { int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, @@ -2270,7 +2270,7 @@ declare 603 { # TIP#265 (option parser) dkf for Sam Bromley declare 604 { int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, - int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) + void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } # TIP#336 (manipulate the error line) dgp @@ -2468,23 +2468,23 @@ declare 648 { # TIP #568 declare 649 { unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - int *numBytesPtr) + void *numBytesPtr) } declare 650 { unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t *numBytesPtr) + Tcl_Size *numBytesPtr) } # TIP #481 declare 651 { - char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) + char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr) } declare 652 { - Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr) + Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr) } # Only available in Tcl 8.x, NULL in Tcl 9.0 declare 653 { - unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr) + unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, Tcl_Size *numBytesPtr) } # TIP #575 @@ -2521,28 +2521,28 @@ declare 660 { # TIP #616 declare 661 { int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - size_t *objcPtr, Tcl_Obj ***objvPtr) + Tcl_Size *objcPtr, Tcl_Obj ***objvPtr) } declare 662 { int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - size_t *lengthPtr) + Tcl_Size *lengthPtr) } declare 663 { - int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr) + int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr) } declare 664 { - int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, size_t *argcPtr, + int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr) } declare 665 { - void Tcl_SplitPath(const char *path, size_t *argcPtr, const char ***argvPtr) + void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr) } declare 666 { - Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr) + Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr) } declare 667 { int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, - size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) + Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } # TIP #617 @@ -2592,7 +2592,7 @@ declare 678 { } declare 679 { int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, - void *clientData, size_t objc, Tcl_Obj *const objv[]) + void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]) } # TIP #638. @@ -2601,7 +2601,7 @@ declare 680 { void **clientDataPtr, int *typePtr) } declare 681 { - int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, size_t numBytes, + int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr) } @@ -2626,9 +2626,15 @@ declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } +# TIP 660 +declare 686 { + int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + Tcl_Size *sizePtr) +} + # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # -declare 687 { +declare 688 { void TclUnusedStubEntry(void) } diff --git a/generic/tcl.h b/generic/tcl.h index 946d7b9ac757..1e33ba1057f0 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -306,16 +306,30 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; # define TCL_Z_MODIFIER "" # endif #endif /* !TCL_Z_MODIFIER */ +#ifndef TCL_T_MODIFIER +# if defined(__GNUC__) && !defined(_WIN32) +# define TCL_T_MODIFIER "t" +# elif defined(_WIN64) +# define TCL_T_MODIFIER TCL_LL_MODIFIER +# else +# define TCL_T_MODIFIER TCL_Z_MODIFIER +# endif +#endif /* !TCL_T_MODIFIER */ + #define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) #define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) #define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if TCL_MAJOR_VERSION < 9 -typedef int Tcl_Size; + typedef int Tcl_Size; +# define TCL_SIZE_MODIFIER "" +# define TCL_SIZE_MAX INT_MAX #else -typedef size_t Tcl_Size; -#endif + typedef ptrdiff_t Tcl_Size; +# define TCL_SIZE_MAX PTRDIFF_MAX +# define TCL_SIZE_MODIFIER TCL_T_MODIFIER +#endif /* TCL_MAJOR_VERSION */ #ifdef _WIN32 # if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T) @@ -450,38 +464,30 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData); * string. */ -#if TCL_MAJOR_VERSION > 8 typedef struct Tcl_RegExpIndices { +#if TCL_MAJOR_VERSION > 8 Tcl_Size start; /* Character offset of first character in * match. */ Tcl_Size end; /* Character offset of first character after * the match. */ +#else + long start; + long end; +#endif } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { Tcl_Size nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ +#if TCL_MAJOR_VERSION > 8 Tcl_Size extendStart; /* The offset at which a subsequent match * might begin. */ -} Tcl_RegExpInfo; #else -typedef struct Tcl_RegExpIndices { - long start; /* Character offset of first character in - * match. */ - long end; /* Character offset of first character after - * the match. */ -} Tcl_RegExpIndices; - -typedef struct Tcl_RegExpInfo { - int nsubs; /* Number of subexpressions in the compiled - * expression. */ - Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ - long extendStart; /* The offset at which a subsequent match - * might begin. */ + long extendStart; long reserved; /* Reserved for later use. */ -} Tcl_RegExpInfo; #endif +} Tcl_RegExpInfo; /* * Picky compilers complain if this typdef doesn't appear before the struct's @@ -555,7 +561,7 @@ typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, - size_t level, const char *command, Tcl_Command commandInfo, size_t objc, + Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc, struct Tcl_Obj *const *objv); typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, @@ -580,7 +586,7 @@ typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, - size_t objc, struct Tcl_Obj *const *objv); + Tcl_Size objc, struct Tcl_Obj *const *objv); typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); @@ -1774,7 +1780,7 @@ typedef struct Tcl_Token { * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR - * token is always preceeded by one + * token is always preceded by one * TCL_TOKEN_SUB_EXPR token for the operator's * subexpression, and is followed by zero or more * TCL_TOKEN_SUB_EXPR tokens for the operator's @@ -1963,15 +1969,18 @@ typedef struct Tcl_EncodingType { #define TCL_ENCODING_CHAR_LIMIT 0x10 /* Internal use bits, do not define bits in this space. See above comment */ #define TCL_ENCODING_INTERNAL_USE_MASK 0xFF00 -/* Reserve top byte for profile values (disjoint, not a mask) */ +/* + * Reserve top byte for profile values (disjoint, not a mask). In case of + * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if + * necessary. + */ #define TCL_ENCODING_PROFILE_TCL8 0x01000000 #define TCL_ENCODING_PROFILE_STRICT 0x02000000 #define TCL_ENCODING_PROFILE_REPLACE 0x03000000 -/* Still being argued - For Tcl9, is the default strict? TODO */ #if TCL_MAJOR_VERSION < 9 #define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 #else -#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 /* STRICT? REPLACE? TODO */ +#define TCL_ENCODING_PROFILE_DEFAULT TCL_ENCODING_PROFILE_TCL8 #endif /* @@ -1993,13 +2002,10 @@ typedef struct Tcl_EncodingType { * TCL_CONVERT_SYNTAX - The source stream contained an invalid * character sequence. This may occur if the * input stream has been damaged or if the input - * encoding method was misidentified. This error - * is reported unless if TCL_ENCODING_NOCOMPLAIN - * was specified. + * encoding method was misidentified. * TCL_CONVERT_UNKNOWN - The source string contained a character that * could not be represented in the target - * encoding. This error is reported unless if - * TCL_ENCODING_NOCOMPLAIN was specified. + * encoding. */ #define TCL_CONVERT_MULTIBYTE (-1) @@ -2017,11 +2023,11 @@ typedef struct Tcl_EncodingType { */ #ifndef TCL_UTF_MAX -#if TCL_MAJOR_VERSION > 8 -#define TCL_UTF_MAX 4 -#else -#define TCL_UTF_MAX 3 -#endif +# if TCL_MAJOR_VERSION > 8 +# define TCL_UTF_MAX 4 +# else +# define TCL_UTF_MAX 3 +# endif #endif /* @@ -2323,7 +2329,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) #endif # define Tcl_MainEx Tcl_MainExW - EXTERN TCL_NORETURN void Tcl_MainExW(size_t argc, wchar_t **argv, + EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8) @@ -2336,7 +2342,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #define TclZipfs_AppHook(argcp, argvp) \ TclInitStubTable(((const char *(*)(int *, void *))TclStubCall((void *)3))(argcp, argvp)) #define Tcl_MainExW(argc, argv, appInitProc, interp) \ - (void)((const char *(*)(size_t, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ + (void)((const char *(*)(Tcl_Size, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ TclStubCall((void *)4))(argc, argv, appInitProc, interp) #if !defined(_WIN32) || !defined(UNICODE) #define Tcl_MainEx(argc, argv, appInitProc, interp) \ diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 8b1bd746f15c..3c4fac3b6a2f 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -116,7 +116,7 @@ static struct block bigBlocks={ /* Big blocks aren't suballocated. */ /* * The allocator is protected by a special mutex that must be explicitly - * initialized. Futhermore, because Tcl_Alloc may be used before anything else + * initialized. Furthermore, because Tcl_Alloc may be used before anything else * in Tcl, we make this module self-initializing after all with the allocInit * variable. */ @@ -510,7 +510,7 @@ TclpFree( void * TclpRealloc( - void *oldPtr, /* Pointer to alloced block. */ + void *oldPtr, /* Pointer to alloc'ed block. */ size_t numBytes) /* New size of memory. */ { int i; @@ -609,7 +609,7 @@ TclpRealloc( } /* - * Ok, we don't have to copy, it fits as-is + * No need to copy. It fits as-is. */ #ifndef NDEBUG diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c index 023274619c13..4571b4a0b8fb 100755 --- a/generic/tclArithSeries.c +++ b/generic/tclArithSeries.c @@ -13,36 +13,95 @@ #include "tclInt.h" #include "tclArithSeries.h" #include +#include /* -------------------------- ArithSeries object ---------------------------- */ +/* + * Helper functions + * + * - ArithRound -- Round doubles to the number of significant fractional + * digits + * - ArithSeriesIndexDbl -- base list indexing operation for doubles + * - ArithSeriesIndexInt -- " " " " " integers + * - ArithSeriesGetInternalRep -- Return the internal rep from a Tcl_Obj + * - Precision -- determine the number of factional digits for the given + * double value + * - maxPrecision -- Using the values provide, determine the longest percision + * in the arithSeries + */ +static inline double +ArithRound(double d, unsigned int n) { + double scalefactor = pow(10, n); + return round(d*scalefactor)/scalefactor; +} -#define ArithSeriesRepPtr(arithSeriesObjPtr) \ - (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1) +static inline double +ArithSeriesIndexDbl( + ArithSeries *arithSeriesRepPtr, + Tcl_WideInt index) +{ + ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; + if (arithSeriesRepPtr->isDouble) { + double d = dblRepPtr->start + (index * dblRepPtr->step); + unsigned n = (dblRepPtr->precision > 0 ? dblRepPtr->precision : 0); + return ArithRound(d, n); + } else { + return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step)); + } +} -#define ArithSeriesIndexM(arithSeriesRepPtr, index) \ - ((arithSeriesRepPtr)->isDouble ? \ - (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \ - : \ - ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step))) +static inline Tcl_WideInt +ArithSeriesIndexInt( + ArithSeries *arithSeriesRepPtr, + Tcl_WideInt index) +{ + ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; + if (arithSeriesRepPtr->isDouble) { + return (Tcl_WideInt)(dblRepPtr->start + ((index) * dblRepPtr->step)); + } else { + return (arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step)); + } +} -#define ArithSeriesGetInternalRep(objPtr, arithRepPtr) \ - do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType); \ - (arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; \ - } while (0) +static inline ArithSeries* +ArithSeriesGetInternalRep(Tcl_Obj *objPtr) +{ + const Tcl_ObjInternalRep *irPtr; + irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType); + return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; +} +static inline int +Precision(double d) +{ + char tmp[TCL_DOUBLE_SPACE+2], *off; + tmp[0] = 0; + Tcl_PrintDouble(NULL,d,tmp); + off = strchr(tmp, '.'); + return (off ? strlen(off+1) : 0); +} +static inline int +maxPrecision(double start, double end, double step) +{ + // Find longest number of digits after the decimal point. + int dp = Precision(step); + int i = Precision(start); + dp = i>dp ? i : dp; + i = Precision(end); + dp = i>dp ? i : dp; + return dp; +} /* * Prototypes for procedures defined later in this file: */ -static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); -static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); -static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj); -static Tcl_Obj *ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr); +static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); +static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj); +static Tcl_Obj* ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr); static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); /* @@ -107,7 +166,7 @@ const TclObjTypeWithAbstractList tclArithSeriesType = { *---------------------------------------------------------------------- */ static Tcl_WideInt -ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) +ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) { Tcl_WideInt len; @@ -118,6 +177,18 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) return (len < 0) ? -1 : len; } +static Tcl_WideInt +ArithSeriesLenDbl(double start, double end, double step) +{ + Tcl_WideInt len; + + if (step == 0) { + return 0; + } + len = ((end-start+step)/step); + return (len < 0) ? -1 : len; +} + /* *---------------------------------------------------------------------- * @@ -140,10 +211,13 @@ static Tcl_Obj * NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len) { - Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); + Tcl_WideInt length; Tcl_Obj *arithSeriesObj; ArithSeries *arithSeriesRepPtr; + length = len>=0 ? len : -1; + if (length < 0) length = -1; + TclNewObj(arithSeriesObj); if (length <= 0) { @@ -184,14 +258,20 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide * None. *---------------------------------------------------------------------- */ + static Tcl_Obj * NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) { - Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); + Tcl_WideInt length; Tcl_Obj *arithSeriesObj; ArithSeriesDbl *arithSeriesRepPtr; + length = len>=0 ? len : -1; + if (length < 0) { + length = -1; + } + TclNewObj(arithSeriesObj); if (length <= 0) { @@ -205,11 +285,14 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) arithSeriesRepPtr->step = step; arithSeriesRepPtr->len = length; arithSeriesRepPtr->elements = NULL; + arithSeriesRepPtr->precision = maxPrecision(start,end,step); arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL; arithSeriesObj->typePtr = &tclArithSeriesType.objType; - if (length > 0) + + if (length > 0) { Tcl_InvalidateStringRep(arithSeriesObj); + } return arithSeriesObj; } @@ -295,7 +378,7 @@ TclNewArithSeriesObj( { double dstart, dend, dstep; Tcl_WideInt start, end, step; - Tcl_WideInt len; + Tcl_WideInt len = -1; if (startObj) { assignNumber(useDoubles, &start, &dstart, startObj); @@ -337,9 +420,9 @@ TclNewArithSeriesObj( assert(dstep!=0); if (!lenObj) { if (useDoubles) { - len = (dend - dstart + dstep)/dstep; + len = ArithSeriesLenDbl(dstart, dend, dstep); } else { - len = (end - start + step)/step; + len = ArithSeriesLenInt(start, end, step); } } } @@ -354,10 +437,10 @@ TclNewArithSeriesObj( } } - if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { + if (len > TCL_SIZE_MAX) { Tcl_SetObjResult( interp, - Tcl_NewStringObj("max length of a Tcl list exceeded", TCL_INDEX_NONE)); + Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } @@ -398,7 +481,7 @@ ArithSeriesObjStep( if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) { Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj."); } - arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (arithSeriesRepPtr->isDouble) { TclNewDoubleObj(stepObj, ((ArithSeriesDbl*)(arithSeriesRepPtr))->step); } else { @@ -430,7 +513,7 @@ ArithSeriesObjStep( Tcl_Obj * TclArithSeriesObjIndex( - Tcl_Interp *interp, + TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj, Tcl_WideInt index) { @@ -439,21 +522,15 @@ TclArithSeriesObjIndex( if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) { Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); } - arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) { - if (interp) { - Tcl_SetObjResult(interp, - Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %" - TCL_Z_MODIFIER "d", index, (arithSeriesRepPtr->len-1))); - Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); - } - return NULL; + return Tcl_NewObj(); } /* List[i] = Start + (Step * index) */ if (arithSeriesRepPtr->isDouble) { - return Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); + return Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index)); } else { - return Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); + return Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index)); } } @@ -541,16 +618,25 @@ DupArithSeriesInternalRep( Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { ArithSeries *srcArithSeriesRepPtr = - (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1; - ArithSeries *copyArithSeriesRepPtr; - + (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1; /* * Allocate a new ArithSeries structure. */ - copyArithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof(ArithSeries)); - *copyArithSeriesRepPtr = *srcArithSeriesRepPtr; - copyArithSeriesRepPtr->elements = NULL; - copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; + if (srcArithSeriesRepPtr->isDouble) { + ArithSeriesDbl *srcArithSeriesDblRepPtr = + (ArithSeriesDbl *)srcArithSeriesRepPtr; + ArithSeriesDbl *copyArithSeriesDblRepPtr = + (ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl)); + *copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr; + copyArithSeriesDblRepPtr->elements = NULL; + copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr; + } else { + ArithSeries *copyArithSeriesRepPtr = + (ArithSeries *) Tcl_Alloc(sizeof(ArithSeries)); + *copyArithSeriesRepPtr = *srcArithSeriesRepPtr; + copyArithSeriesRepPtr->elements = NULL; + copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; + } copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &tclArithSeriesType.objType; } @@ -591,29 +677,47 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj) char *elem, *p; Tcl_Obj *elemObj; Tcl_Size i; - Tcl_WideInt length = 0; - size_t slen; + Tcl_Size length = 0; + Tcl_Size slen; /* * Pass 1: estimate space. */ - for (i = 0; i < arithSeriesRepPtr->len; i++) { - elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i); - elem = Tcl_GetStringFromObj(elemObj, &slen); - Tcl_DecrRefCount(elemObj); - slen += 1; /* + 1 is for the space or the nul-term */ - length += slen; + if (!arithSeriesRepPtr->isDouble) { + for (i = 0; i < arithSeriesRepPtr->len; i++) { + double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i); + slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1; + length += slen; + } + } else { + for (i = 0; i < arithSeriesRepPtr->len; i++) { + double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i); + char tmp[TCL_DOUBLE_SPACE+2]; + tmp[0] = 0; + Tcl_PrintDouble(NULL,d,tmp); + if ((length + strlen(tmp)) > TCL_SIZE_MAX) { + break; // overflow + } + length += strlen(tmp); + } } + length += arithSeriesRepPtr->len; // Space for each separator /* * Pass 2: generate the string repr. */ p = Tcl_InitStringRep(arithSeriesObj, NULL, length); + if (p == NULL) { + Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length); + } for (i = 0; i < arithSeriesRepPtr->len; i++) { elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i); elem = Tcl_GetStringFromObj(elemObj, &slen); - strcpy(p, elem); + if (((p - arithSeriesObj->bytes)+slen) > length) { + break; + } + strncpy(p, elem, slen); p[slen] = ' '; p += slen+1; Tcl_DecrRefCount(elemObj); @@ -685,7 +789,7 @@ TclArithSeriesObjCopy( Tcl_Obj *copyPtr; ArithSeries *arithSeriesRepPtr; - ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (NULL == arithSeriesRepPtr) { if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) { /* We know this is going to panic, but it's the message we want */ @@ -728,17 +832,30 @@ TclArithSeriesObjRange( ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; - ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); if (fromIdx == TCL_INDEX_NONE) { fromIdx = 0; } - if (fromIdx > toIdx) { + + if (fromIdx > toIdx || + (toIdx > arithSeriesRepPtr->len-1 && + fromIdx > arithSeriesRepPtr->len-1)) { Tcl_Obj *obj; TclNewObj(obj); return obj; } + if (fromIdx < 0) { + fromIdx = 0; + } + if (toIdx < 0) { + toIdx = 0; + } + if (toIdx > arithSeriesRepPtr->len-1) { + toIdx = arithSeriesRepPtr->len-1; + } + startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx); if (startObj == NULL) { return NULL; @@ -778,15 +895,17 @@ TclArithSeriesObjRange( TclInvalidateStringRep(arithSeriesObj); if (arithSeriesRepPtr->isDouble) { - ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesObj; + ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr; double start, end, step; + Tcl_GetDoubleFromObj(NULL, startObj, &start); Tcl_GetDoubleFromObj(NULL, endObj, &end); Tcl_GetDoubleFromObj(NULL, stepObj, &step); arithSeriesDblRepPtr->start = start; arithSeriesDblRepPtr->end = end; arithSeriesDblRepPtr->step = step; - arithSeriesDblRepPtr->len = (end-start+step)/step; + arithSeriesDblRepPtr->precision = maxPrecision(start, end, step); + arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step); arithSeriesDblRepPtr->elements = NULL; } else { @@ -797,7 +916,7 @@ TclArithSeriesObjRange( arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; arithSeriesRepPtr->step = step; - arithSeriesRepPtr->len = (end-start+step)/step; + arithSeriesRepPtr->len = ArithSeriesLenInt(start, end, step); arithSeriesRepPtr->elements = NULL; } @@ -852,7 +971,7 @@ TclArithSeriesGetElements( Tcl_Obj **objv; int i, objc; - ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr); objc = arithSeriesRepPtr->len; if (objc > 0) { if (arithSeriesRepPtr->elements) { @@ -865,7 +984,7 @@ TclArithSeriesGetElements( if (interp) { Tcl_SetObjResult( interp, - Tcl_NewStringObj("max length of a Tcl list exceeded", TCL_INDEX_NONE)); + Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; @@ -927,7 +1046,7 @@ TclArithSeriesObjReverse( double dstart, dend, dstep; int isDouble; - ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr); + arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj); isDouble = arithSeriesRepPtr->isDouble; len = arithSeriesRepPtr->len; diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h index f59720cc1559..61538c484dc3 100644 --- a/generic/tclArithSeries.h +++ b/generic/tclArithSeries.h @@ -16,7 +16,7 @@ * but it's faster to cache it inside the internal representation. */ typedef struct { - Tcl_Size len; + Tcl_WideInt len; Tcl_Obj **elements; int isDouble; Tcl_WideInt start; @@ -24,12 +24,13 @@ typedef struct { Tcl_WideInt step; } ArithSeries; typedef struct { - Tcl_Size len; + Tcl_WideInt len; Tcl_Obj **elements; int isDouble; double start; double end; double step; + int precision; } ArithSeriesDbl; diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index af95312597d9..910532eb536c 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -222,7 +222,7 @@ typedef struct AssemblyEnv { Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ - size_t cmdLine; /* Current line number within the assembly + Tcl_Size cmdLine; /* Current line number within the assembly * code */ int* clNext; /* Invisible continuation line for * [info frame] */ @@ -857,7 +857,7 @@ CompileAssembleObj( * names in the bytecode resolve */ int status; /* Status return from Tcl_AssembleCode */ const char* source; /* String representation of the source code */ - size_t sourceLen; /* Length of the source code in bytes */ + Tcl_Size sourceLen; /* Length of the source code in bytes */ /* * Get the expression ByteCode from the object. If it exists, make sure it @@ -1269,10 +1269,10 @@ AssembleOneLine( Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ - size_t operand1Len; /* String length of the operand */ + Tcl_Size operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ - size_t localVar; /* LVT index of a local variable */ + Tcl_Size localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ @@ -1367,7 +1367,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); @@ -1384,7 +1384,7 @@ AssembleOneLine( } if (opnd < 0 || opnd > 3) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("operand must be [0..3]", TCL_INDEX_NONE)); + Tcl_NewStringObj("operand must be [0..3]", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL); goto cleanup; } @@ -1427,7 +1427,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); @@ -1444,7 +1444,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); @@ -1625,7 +1625,7 @@ AssembleOneLine( if (opnd < 2) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("operand must be >=2", TCL_INDEX_NONE)); + Tcl_NewStringObj("operand must be >=2", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL); } goto cleanup; @@ -1639,7 +1639,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { goto cleanup; } BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); @@ -1651,7 +1651,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE || CheckOneByte(interp, localVar)) { + if (localVar < 0 || CheckOneByte(interp, localVar)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); @@ -1663,7 +1663,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE || CheckOneByte(interp, localVar) + if (localVar < 0 || CheckOneByte(interp, localVar) || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd)) { goto cleanup; @@ -1678,7 +1678,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); @@ -1742,7 +1742,7 @@ AssembleOneLine( goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0); @@ -1969,7 +1969,7 @@ CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { - size_t objc; /* Number of elements in the 'jumps' list */ + Tcl_Size objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ @@ -1982,7 +1982,7 @@ CreateMirrorJumpTable( Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */ int isNew; /* Flag==1 if the key is not yet in the * table. */ - size_t i; + Tcl_Size i; if (TclListObjLengthM(interp, jumps, &objc) != TCL_OK) { return TCL_ERROR; @@ -2107,7 +2107,7 @@ GetNextOperand( Tcl_DecrRefCount(operandObj); if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "assembly code may not contain substitutions", TCL_INDEX_NONE)); + "assembly code may not contain substitutions", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL); } return TCL_ERROR; @@ -2313,8 +2313,8 @@ FindLocalVar( * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; - size_t varNameLen; - size_t localVar; /* Index of the variable in the LVT */ + Tcl_Size varNameLen; + Tcl_Size localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return TCL_INDEX_NONE; @@ -2326,11 +2326,11 @@ FindLocalVar( } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use this instruction to create a variable" - " in a non-proc context", TCL_INDEX_NONE)); + " in a non-proc context", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL); } return TCL_INDEX_NONE; @@ -2400,7 +2400,7 @@ CheckOneByte( Tcl_Obj* result; /* Error message */ if (value < 0 || value > 0xFF) { - result = Tcl_NewStringObj("operand does not fit in one byte", TCL_INDEX_NONE); + result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; @@ -2435,7 +2435,7 @@ CheckSignedOneByte( Tcl_Obj* result; /* Error message */ if (value > 0x7F || value < -0x80) { - result = Tcl_NewStringObj("operand does not fit in one byte", TCL_INDEX_NONE); + result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; @@ -2468,7 +2468,7 @@ CheckNonNegative( Tcl_Obj* result; /* Error message */ if (value < 0) { - result = Tcl_NewStringObj("operand must be nonnegative", TCL_INDEX_NONE); + result = Tcl_NewStringObj("operand must be nonnegative", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL); return TCL_ERROR; @@ -2501,7 +2501,7 @@ CheckStrictlyPositive( Tcl_Obj* result; /* Error message */ if (value <= 0) { - result = Tcl_NewStringObj("operand must be positive", TCL_INDEX_NONE); + result = Tcl_NewStringObj("operand must be positive", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL); return TCL_ERROR; @@ -3321,7 +3321,7 @@ CheckStack( { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ - size_t maxDepth; /* Maximum stack depth overall */ + Tcl_Size maxDepth; /* Maximum stack depth overall */ /* * Checking the head block will check all the other blocks recursively. @@ -3414,7 +3414,7 @@ StackCheckBasicBlock( } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "inconsistent stack depths on two execution paths", TCL_INDEX_NONE)); + "inconsistent stack depths on two execution paths", -1)); /* * TODO - add execution trace of both paths @@ -3443,7 +3443,7 @@ StackCheckBasicBlock( if (initialStackDepth + blockPtr->minStackDepth < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); @@ -3462,8 +3462,8 @@ StackCheckBasicBlock( + blockPtr->enclosingCatch->finalStackDepth)) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "code pops stack below level of enclosing catch", TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", TCL_INDEX_NONE); + "code pops stack below level of enclosing catch", -1)); + Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } @@ -3734,7 +3734,7 @@ ProcessCatchesInBasicBlock( if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "execution reaches an instruction in inconsistent " - "exception contexts", TCL_INDEX_NONE)); + "exception contexts", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL); } @@ -3793,7 +3793,7 @@ ProcessCatchesInBasicBlock( if (enclosing == NULL) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "endCatch without a corresponding beginCatch", TCL_INDEX_NONE)); + "endCatch without a corresponding beginCatch", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL); } @@ -3868,7 +3868,7 @@ CheckForUnclosedCatches( if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "catch still active on exit from assembly code", TCL_INDEX_NONE)); + "catch still active on exit from assembly code", -1)); Tcl_SetErrorLine(interp, assemEnvPtr->curr_bb->enclosingCatch->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 9b1b5a5ed794..02940e734d83 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -93,7 +93,7 @@ typedef struct { * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ - size_t length; /* Length of the above error message. */ + Tcl_Size length; /* Length of the above error message. */ void *clientData; /* Not used. */ int flags; /* Additional flags */ } CancelInfo; @@ -220,8 +220,8 @@ MODULE_SCOPE const TclStubs tclStubs; #define CORO_ACTIVATE_YIELD NULL #define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL ((size_t)-1) -#define COROUTINE_ARGUMENTS_ARBITRARY ((size_t)-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -613,15 +613,15 @@ static int buildInfoObjCmd2( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - if (objc - 1 > 1) { + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; } if (objc == 2) { - size_t len; + Tcl_Size len; const char *arg = Tcl_GetStringFromObj(objv[1], &len); if (len == 7 && !strcmp(arg, "version")) { char buf[80]; @@ -702,7 +702,7 @@ buildInfoObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - return buildInfoObjCmd2(clientData, interp, (size_t)objc, objv); + return buildInfoObjCmd2(clientData, interp, objc, objv); } /* @@ -1031,7 +1031,7 @@ Tcl_CreateInterp(void) /* * Create the core commands. Do it here, rather than calling * Tcl_CreateCommand, because it's faster (there's no need to check for a - * pre-existing command by the same name). If a command has a Tcl_CmdProc + * preexisting command by the same name). If a command has a Tcl_CmdProc * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to * TclInvokeStringCommand. This is an object-based wrapper function that * extracts strings, calls the string function, and creates an object for @@ -1499,7 +1499,7 @@ Tcl_CallWhenDeleted( AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; - sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr); + snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { @@ -1799,7 +1799,7 @@ DeleteInterpProc( Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; - size_t i; + Tcl_Size i; /* * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup, @@ -2152,7 +2152,7 @@ Tcl_HideCommand( if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" - " token (rename)", TCL_INDEX_NONE)); + " token (rename)", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL); return TCL_ERROR; } @@ -2209,15 +2209,15 @@ Tcl_HideCommand( } /* - * NB: This code is currently 'like' a rename to a specialy set apart name + * NB: This code is currently 'like' a rename to a special separate name * table. Changes here and in TclRenameCommand must be kept in synch until * the common parts are actually factorized out. */ /* * Remove the hash entry for the command from the interpreter command - * table. This is like deleting the command, so bump its command epoch; - * this invalidates any cached references that point to the command. + * table. This is like deleting the command, so bump its command epoch + * to invalidate any cached references that point to the command. */ if (cmdPtr->hPtr != NULL) { @@ -2338,7 +2338,7 @@ Tcl_ExposeCommand( if (cmdPtr->nsPtr != iPtr->globalNsPtr) { /* - * This case is theoritically impossible, we might rather Tcl_Panic + * This case is theoretically impossible, we might rather Tcl_Panic * than 'nicely' erroring out ? */ @@ -2444,7 +2444,7 @@ Tcl_ExposeCommand( * In the future, when cmdName is seen as the name of a command by * Tcl_Eval, proc will be called. To support the bytecode interpreter, * the command is created with a wrapper Tcl_ObjCmdProc - * (TclInvokeStringCommand) that eventially calls proc. When the command + * (TclInvokeStringCommand) that eventually calls proc. When the command * is deleted from the table, deleteProc will be called. See the manual * entry for details on the calling sequence. * @@ -2665,7 +2665,7 @@ static int cmdWrapperProc(void *clientData, if (objc < 0) { objc = -1; } - return info->proc(info->clientData, interp, (size_t)objc, objv); + return info->proc(info->clientData, interp, objc, objv); } static void cmdWrapperDeleteProc(void *clientData) { @@ -3188,11 +3188,11 @@ TclRenameCommand( */ Tcl_DStringInit(&newFullName); - Tcl_DStringAppend(&newFullName, newNsPtr->fullName, TCL_INDEX_NONE); + Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { TclDStringAppendLiteral(&newFullName, "::"); } - Tcl_DStringAppend(&newFullName, newTail, TCL_INDEX_NONE); + Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); @@ -3291,14 +3291,14 @@ static int invokeObj2Command( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { - objc = TCL_INDEX_NONE; + return TclCommandWordLimitError(interp, objc); } if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); @@ -3311,10 +3311,13 @@ invokeObj2Command( static int cmdWrapper2Proc(void *clientData, Tcl_Interp *interp, - size_t objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { Command *cmdPtr = (Command *)clientData; + if (objc > INT_MAX) { + return TclCommandWordLimitError(interp, objc); + } return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } @@ -3553,14 +3556,14 @@ Tcl_GetCommandFullName( if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) { if (cmdPtr->nsPtr != NULL) { - Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, TCL_INDEX_NONE); + Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1); if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (cmdPtr->hPtr != NULL) { name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); - Tcl_AppendToObj(objPtr, name, TCL_INDEX_NONE); + Tcl_AppendToObj(objPtr, name, -1); } } } @@ -3931,7 +3934,7 @@ CallCommandTraces( * The value given for the code argument. * * Side effects: - * Transfers a message from the cancelation message to the interpreter. + * Transfers a message from the cancellation message to the interpreter. * *---------------------------------------------------------------------- */ @@ -4061,7 +4064,7 @@ TclInterpReady( if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to call eval in deleted interpreter", TCL_INDEX_NONE)); + "attempt to call eval in deleted interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "IDELETE", "attempt to call eval in deleted interpreter", NULL); return TCL_ERROR; @@ -4090,7 +4093,7 @@ TclInterpReady( } Tcl_SetObjResult(interp, Tcl_NewStringObj( - "too many nested evaluations (infinite loop?)", TCL_INDEX_NONE)); + "too many nested evaluations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); return TCL_ERROR; } @@ -4199,7 +4202,7 @@ Tcl_Canceled( if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; - size_t length; + Tcl_Size length; /* * Setup errorCode variables so that we can differentiate between @@ -4224,7 +4227,7 @@ Tcl_Canceled( } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL); } @@ -4370,7 +4373,7 @@ int Tcl_EvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - size_t objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -4389,7 +4392,7 @@ int TclNREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - size_t objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags, /* Collection of OR-ed bits that control the @@ -4797,7 +4800,7 @@ TEOV_Error( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; - size_t cmdLen; + Tcl_Size cmdLen; int objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; @@ -4826,7 +4829,7 @@ TEOV_NotFound( { Command * cmdPtr; Interp *iPtr = (Interp *) interp; - size_t i, newObjc, handlerObjc; + Tcl_Size i, newObjc, handlerObjc; Tcl_Obj **newObjv, **handlerObjv; CallFrame *varFramePtr = iPtr->varFramePtr; Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered @@ -4854,7 +4857,7 @@ TEOV_NotFound( /* * Get the list of words for the unknown handler and allocate enough space - * to hold both the handler prefix and all words of the command invokation + * to hold both the handler prefix and all words of the command invocation * itself. */ @@ -4953,7 +4956,7 @@ TEOV_RunEnterTraces( { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; - size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; + Tcl_Size length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int traceCode = TCL_OK; const char *command = Tcl_GetStringFromObj(commandPtr, &length); @@ -5006,7 +5009,7 @@ TEOV_RunLeaveTraces( Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; - size_t length; + Tcl_Size length; const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_DYING)) { @@ -5089,7 +5092,7 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - size_t count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, @@ -5122,7 +5125,7 @@ Tcl_EvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ - size_t numBytes, /* Number of bytes in script. If -1, the + Tcl_Size numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first null character. */ int flags) /* Collection of OR-ed bits that control the @@ -5137,19 +5140,19 @@ TclEvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ - size_t numBytes, /* Number of bytes in script. If -1, the + Tcl_Size numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first NUL character. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ - size_t line, /* The line the script starts on. */ + Tcl_Size line, /* The line the script starts on. */ int *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' * refers to the most-outer script containing - * the embedded command, which is refered to + * the embedded command, which is referred to * by 'script'. The 'clNextOuter' refers to * the current entry in the table of * continuation lines in this "main script", @@ -5164,17 +5167,17 @@ TclEvalEx( { Interp *iPtr = (Interp *) interp; const char *p, *next; - const unsigned int minObjs = 20; + const int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; - int bytesLeft, expandRequested, code = TCL_OK; - size_t commandLength; + int expandRequested, code = TCL_OK; + Tcl_Size bytesLeft, commandLength; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; - TCL_HASH_TYPE i, objectsUsed = 0; + Tcl_Size i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed @@ -5203,7 +5206,7 @@ TclEvalEx( } } - if (numBytes == TCL_INDEX_NONE) { + if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); @@ -5309,11 +5312,11 @@ TclEvalEx( * per-command parsing. */ - size_t wordLine = line; + Tcl_Size wordLine = line; const char *wordStart = parsePtr->commandStart; int *wordCLNext = clNext; - unsigned int objectsNeeded = 0; - unsigned int numWords = parsePtr->numWords; + Tcl_Size objectsNeeded = 0; + Tcl_Size numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. @@ -5332,6 +5335,8 @@ TclEvalEx( for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { + Tcl_Size additionalObjsCount; + /* * TIP #280. Track lines to current word. Save the information * on a per-word basis, signaling dynamic words as needed. @@ -5364,7 +5369,7 @@ TclEvalEx( objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { - size_t numElements; + Tcl_Size numElements; code = TclListObjLengthM(interp, objv[objectsUsed], &numElements); @@ -5381,11 +5386,21 @@ TclEvalEx( expandRequested = 1; expand[objectsUsed] = 1; - objectsNeeded += (numElements ? numElements : 1); + additionalObjsCount = (numElements ? numElements : 1); + } else { expand[objectsUsed] = 0; - objectsNeeded++; + additionalObjsCount = 1; + } + + /* Currently max command words in INT_MAX */ + if (additionalObjsCount > INT_MAX || + objectsNeeded > (INT_MAX - additionalObjsCount)) { + code = TclCommandWordLimitError(interp, -1); + Tcl_DecrRefCount(objv[objectsUsed]); + break; } + objectsNeeded += additionalObjsCount; if (wordCLNext) { TclContinuationsEnterDerived(objv[objectsUsed], @@ -5415,7 +5430,7 @@ TclEvalEx( objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { - size_t numElements; + Tcl_Size numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; TclListObjGetElementsM(NULL, temp, &numElements, @@ -5608,7 +5623,7 @@ TclEvalEx( void TclAdvanceLines( - size_t *line, + Tcl_Size *line, const char *start, const char *end) { @@ -5643,7 +5658,7 @@ TclAdvanceLines( void TclAdvanceContinuations( - size_t *line, + Tcl_Size *line, int **clNextPtrPtr, int loc) { @@ -5715,8 +5730,8 @@ TclArgumentEnter( /* * Ignore argument words without line information (= dynamic). If they * are variables they may have location information associated with - * that, either through globally recorded 'set' invokations, or - * literals in bytecode. Eitehr way there is no need to record + * that, either through globally recorded 'set' invocations, or + * literals in bytecode. Either way there is no need to record * something here. */ @@ -5823,7 +5838,7 @@ TclArgumentBCEnter( void *codePtr, CmdFrame *cfPtr, int cmd, - size_t pc) + Tcl_Size pc) { ExtCmdLoc *eclPtr; int word; @@ -5852,7 +5867,7 @@ TclArgumentBCEnter( * housekeeping, and can escape now. */ - if (ePtr->nline != (size_t)objc) { + if (ePtr->nline != objc) { return; } @@ -6112,7 +6127,7 @@ TclNREvalObjEx( if (TclListObjIsCanonical(objPtr)) { CmdFrame *eoFramePtr = NULL; - size_t objc; + Tcl_Size objc; Tcl_Obj *listPtr, **objv; /* @@ -6222,7 +6237,7 @@ TclNREvalObjEx( */ const char *script; - size_t numSrcBytes; + Tcl_Size numSrcBytes; /* * Now we check if we have data about invisible continuation lines for @@ -6276,7 +6291,7 @@ TEOEx_ByteCodeCallback( } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; - size_t numSrcBytes; + Tcl_Size numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; @@ -6361,15 +6376,15 @@ ProcessUnexpectedResult( Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invoked \"break\" outside of a loop", TCL_INDEX_NONE)); + "invoked \"break\" outside of a loop", -1)); } else if (returnCode == TCL_CONTINUE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invoked \"continue\" outside of a loop", TCL_INDEX_NONE)); + "invoked \"continue\" outside of a loop", -1)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); } - sprintf(buf, "%d", returnCode); + snprintf(buf, sizeof(buf), "%d", returnCode); Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL); } @@ -6410,7 +6425,7 @@ Tcl_ExprLong( *ptr = 0; } else { - exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); + exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); @@ -6435,7 +6450,7 @@ Tcl_ExprDouble( *ptr = 0.0; } else { - exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); + exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); @@ -6460,7 +6475,7 @@ Tcl_ExprBoolean( return TCL_OK; } else { int result; - Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); + Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); @@ -6673,7 +6688,7 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", TCL_INDEX_NONE)); + "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { @@ -6772,7 +6787,7 @@ Tcl_ExprString( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { - Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, TCL_INDEX_NONE); + Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1); Tcl_IncrRefCount(exprObj); code = Tcl_ExprObj(interp, exprObj, &resultPtr); @@ -6810,7 +6825,7 @@ Tcl_AppendObjToErrorInfo( * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { - size_t length; + Tcl_Size length; const char *message = Tcl_GetStringFromObj(objPtr, &length); Interp *iPtr = (Interp *) interp; @@ -6886,10 +6901,10 @@ Tcl_VarEval( if (string == NULL) { break; } - Tcl_DStringAppend(&buf, string, TCL_INDEX_NONE); + Tcl_DStringAppend(&buf, string, -1); } - result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, 0); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); Tcl_DStringFree(&buf); return result; } @@ -6911,17 +6926,17 @@ Tcl_VarEval( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_SetRecursionLimit( Tcl_Interp *interp, /* Interpreter whose nesting limit is to be * set. */ - size_t depth) /* New value for maximimum depth. */ + Tcl_Size depth) /* New value for maximimum depth. */ { Interp *iPtr = (Interp *) interp; - size_t old; + Tcl_Size old; old = iPtr->maxNestingDepth; - if (depth + 1 > 1) { + if (depth > 0) { iPtr->maxNestingDepth = depth; } return old; @@ -7192,7 +7207,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", TCL_INDEX_NONE)); + "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); return TCL_ERROR; @@ -7394,7 +7409,7 @@ ExprAbsFunc( goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { - size_t numBytes; + Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); while (numBytes) { @@ -8474,7 +8489,7 @@ Tcl_NRCallObjProc( Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, - size_t objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { NRE_callback *rootPtr = TOP_CB(interp); @@ -8497,7 +8512,7 @@ int wrapperNRObjProc( if (objc < 0) { objc = -1; } - return proc(clientData, interp, (size_t)objc, objv); + return proc(clientData, interp, (Tcl_Size)objc, objv); } int @@ -8505,7 +8520,7 @@ Tcl_NRCallObjProc2( Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc, void *clientData, - size_t objc, + ptrdiff_t objc, Tcl_Obj *const objv[]) { if (objc > INT_MAX) { @@ -8561,7 +8576,7 @@ static int cmdWrapperNreProc( if (objc < 0) { objc = -1; } - return info->nreProc(info->clientData, interp, (size_t)objc, objv); + return info->nreProc(info->clientData, interp, objc, objv); } Tcl_Command @@ -8657,7 +8672,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - size_t objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -8672,7 +8687,7 @@ int Tcl_NRCmdSwap( Tcl_Interp *interp, Tcl_Command cmd, - size_t objc, + Tcl_Size objc, Tcl_Obj *const objv[], int flags) { @@ -8806,7 +8821,7 @@ TclNRTailcallObjCmd( if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE)); + "tailcall can only be called from a proc, lambda or method", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); return TCL_ERROR; } @@ -8836,7 +8851,7 @@ TclNRTailcallObjCmd( * namespace, the rest the command to be tailcalled. */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); @@ -8864,7 +8879,7 @@ TclNRTailcallEval( Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; - size_t objc; + Tcl_Size objc; Tcl_Obj **objv; TclListObjGetElementsM(interp, listPtr, &objc, &objv); @@ -8968,7 +8983,7 @@ TclNRYieldObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", TCL_INDEX_NONE)); + "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } @@ -9001,14 +9016,14 @@ TclNRYieldToObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", TCL_INDEX_NONE)); + "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto called in deleted namespace", TCL_INDEX_NONE)); + "yieldto called in deleted namespace", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", NULL); return TCL_ERROR; @@ -9021,7 +9036,7 @@ TclNRYieldToObjCmd( */ listPtr = Tcl_NewListObj(objc, objv); - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); /* @@ -9212,7 +9227,7 @@ TclNRCoroutineActivateCallback( */ corPtr->stackLevel = &corPtr; - size_t numLevels = corPtr->auxNumLevels; + Tcl_Size numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; SAVE_CONTEXT(corPtr->caller); @@ -9243,7 +9258,7 @@ TclNRCoroutineActivateCallback( Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", TCL_INDEX_NONE)); + "cannot yield: C stack busy", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", NULL); return TCL_ERROR; @@ -9261,7 +9276,7 @@ TclNRCoroutineActivateCallback( corPtr->yieldPtr = NULL; corPtr->stackLevel = NULL; - size_t numLevels = iPtr->numLevels; + Tcl_Size numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; @@ -9288,7 +9303,7 @@ TclNREvalList( Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { - size_t objc; + Tcl_Size objc; Tcl_Obj **objv; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; @@ -9332,7 +9347,7 @@ CoroTypeObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", TCL_INDEX_NONE)); + "can only get coroutine type of a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; @@ -9345,7 +9360,7 @@ CoroTypeObjCmd( corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); return TCL_OK; } @@ -9356,14 +9371,14 @@ CoroTypeObjCmd( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); return TCL_OK; default: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", TCL_INDEX_NONE)); + "unknown coroutine type", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL); return TCL_ERROR; } @@ -9392,7 +9407,7 @@ GetCoroutineFromObj( Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objPtr), NULL); return NULL; @@ -9426,7 +9441,7 @@ TclNRCoroInjectObjCmd( } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); + "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } @@ -9504,7 +9519,7 @@ TclNRCoroProbeObjCmd( */ corPtr->stackLevel = &corPtr; - size_t numLevels = corPtr->auxNumLevels; + Tcl_Size numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; /* @@ -9548,9 +9563,9 @@ InjectHandler( { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; - size_t nargs = PTR2INT(data[2]); + Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; - size_t objc; + Tcl_Size objc; Tcl_Obj **objv; if (!isProbe) { @@ -9595,7 +9610,7 @@ InjectHandlerPostCall( { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; - size_t nargs = PTR2INT(data[2]); + Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; /* @@ -9618,7 +9633,7 @@ InjectHandlerPostCall( } corPtr->nargs = nargs; corPtr->stackLevel = NULL; - size_t numLevels = iPtr->numLevels; + Tcl_Size numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; iPtr->execEnvPtr = corPtr->callerEEPtr; @@ -9663,7 +9678,7 @@ NRInjectObjCmd( } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); + "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } @@ -9714,10 +9729,10 @@ TclNRInterpCoroutine( } break; default: - if (corPtr->nargs + 1 != (size_t)objc) { + if (corPtr->nargs + 1 != objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", TCL_INDEX_NONE)); + "not implemented!", -1)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 1083533b8d5b..dd8b292aae5b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -22,11 +22,11 @@ * special conditions in the parsing of a format specifier. */ -#define BINARY_ALL ((size_t)-1) /* Use all elements in the argument. */ -#define BINARY_NOCOUNT ((size_t)-2) /* No count was specified in format. */ +#define BINARY_ALL -1 /* Use all elements in the argument. */ +#define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* - * The following flags may be ORed together and returned by GetFormatSpec + * The following flags may be OR'ed together and returned by GetFormatSpec */ #define BINARY_SIGNED 0 /* Field to be read as signed data */ @@ -37,7 +37,7 @@ * placed in the object cache by 'binary scan' before it bails out and * switches back to Plan A (creating a new object for each value.) * Theoretically, it would be possible to keep the cache about for the values - * that are already in it, but that makes the code slower in practise when + * that are already in it, but that makes the code slower in practice when * overflow happens, and makes little odds the rest of the time (as measured * on my machine.) It is also slower (on the sample I tried at least) to grow * the cache to hold all items we might want to put in it; presumably the @@ -61,10 +61,10 @@ static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(const char **formatPtr, char *cmdPtr, - size_t *countPtr, int *flagsPtr); + Tcl_Size *countPtr, int *flagsPtr); static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, int flags, Tcl_HashTable **numberCachePtr); -static int SetByteArrayFromAny(Tcl_Interp *interp, size_t limit, +static int SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Size limit, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); @@ -174,18 +174,19 @@ static const Tcl_ObjType properByteArrayType = { */ typedef struct { - size_t used; /* The number of bytes used in the byte + Tcl_Size used; /* The number of bytes used in the byte * array. */ - size_t allocated; /* The amount of space actually allocated + Tcl_Size allocated; /* The amount of space actually allocated * minus 1 byte. */ unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; +#define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) #define BYTEARRAY_SIZE(len) \ - ( (offsetof(ByteArray, bytes) + (len) < offsetof(ByteArray, bytes)) \ - ? (Tcl_Panic("max size of a Tcl value exceeded"), 0) \ + ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ + ? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \ : (offsetof(ByteArray, bytes) + (len)) ) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ @@ -222,7 +223,7 @@ Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - size_t numBytes) /* Number of bytes in the array */ + Tcl_Size numBytes) /* Number of bytes in the array */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0); @@ -265,7 +266,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - size_t numBytes, /* Number of bytes in the array */ + Tcl_Size numBytes, /* Number of bytes in the array */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for @@ -282,7 +283,7 @@ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ - size_t numBytes, /* Number of bytes in the array */ + Tcl_Size numBytes, /* Number of bytes in the array */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { @@ -313,7 +314,8 @@ Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if numBytes > 0. */ - size_t numBytes) /* Number of bytes in the array */ + Tcl_Size numBytes) /* Number of bytes in the array. + * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep ir; @@ -323,6 +325,7 @@ Tcl_SetByteArrayObj( } TclInvalidateStringRep(objPtr); + assert(numBytes >= 0); byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes)); byteArrayPtr->used = numBytes; byteArrayPtr->allocated = numBytes; @@ -357,7 +360,7 @@ unsigned char * Tcl_GetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ - size_t *numBytesPtr) /* If non-NULL, write the number of bytes + Tcl_Size *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { ByteArray *baPtr; @@ -378,14 +381,15 @@ Tcl_GetBytesFromObj( return baPtr->bytes; } +#if !defined(TCL_NO_DEPRECATED) unsigned char * TclGetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ - int *numBytesPtr) /* If non-NULL, write the number of bytes + void *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { - size_t numBytes = 0; + Tcl_Size numBytes = 0; unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes); if (bytes && numBytesPtr) { @@ -395,16 +399,17 @@ TclGetBytesFromObj( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "byte sequence length exceeds INT_MAX", TCL_INDEX_NONE)); + "byte sequence length exceeds INT_MAX", -1)); Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL); } return NULL; } else { - *numBytesPtr = (int) numBytes; + *(int *)numBytesPtr = (int) numBytes; } } return bytes; } +#endif /* *---------------------------------------------------------------------- @@ -431,11 +436,13 @@ TclGetBytesFromObj( unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ - size_t numBytes) /* Number of bytes in resized array */ + Tcl_Size numBytes) /* Number of bytes in resized array + * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep *irPtr; + assert(numBytes >= 0); if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } @@ -466,8 +473,8 @@ Tcl_SetByteArrayLength( * MakeByteArray -- * * Generate a ByteArray internal rep from the string rep of objPtr. - * The generated byte sequence may have no more than limit bytes. The - * value of TCL_INDEX_NONE for limit indicates no limit imposed. If + * The generated byte sequence may have no more than limit bytes. + * A negative value for limit indicates no limit imposed. If * boolean argument demandProper is true, then no byte sequence should * be output to the caller (write NULL instead). When no bytes sequence * is output and interp is not NULL, leave an error message and error @@ -487,14 +494,13 @@ static int MakeByteArray( Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t limit, + Tcl_Size limit, int demandProper, ByteArray **byteArrayPtrPtr) { - size_t length; + Tcl_Size length; const char *src = Tcl_GetStringFromObj(objPtr, &length); - size_t numBytes - = (limit != TCL_INDEX_NONE && limit < length) ? limit : length; + Tcl_Size numBytes = (limit >= 0 && limit < length) ? limit : length; ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes)); unsigned char *dst = byteArrayPtr->bytes; unsigned char *dstEnd = dst + numBytes; @@ -569,7 +575,7 @@ TclNarrowToBytes( static int SetByteArrayFromAny( Tcl_Interp *interp, /* For error reporting. */ - size_t limit, /* Create no more than this many bytes */ + Tcl_Size limit, /* Create no more than this many bytes */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { ByteArray *byteArrayPtr; @@ -630,7 +636,7 @@ DupProperByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - size_t length; + Tcl_Size length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjInternalRep ir; @@ -671,8 +677,8 @@ UpdateStringOfByteArray( const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; - size_t i, length = byteArrayPtr->used; - size_t size = length; + Tcl_Size i, length = byteArrayPtr->used; + Tcl_Size size = length; /* * How much space will string rep need? @@ -721,16 +727,16 @@ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, - size_t len) + Tcl_Size len) { ByteArray *byteArrayPtr; - size_t needed; + Tcl_Size needed; Tcl_ObjInternalRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } - if (len == TCL_INDEX_NONE) { + if (len < 0) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } @@ -755,11 +761,11 @@ TclAppendBytesToByteArray( * If we need to, resize the allocated space in the byte array. */ - needed = byteArrayPtr->used + len; - if (needed < byteArrayPtr->used) { - /* Wrapped around SIZE_MAX!! */ - Tcl_Panic("max size of a Tcl value exceeded"); + if ((BYTEARRAY_MAX_LEN - byteArrayPtr->used) < len) { + /* Will wrap around !! */ + Tcl_Panic("max size of a byte array exceeded"); } + needed = byteArrayPtr->used + len; if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; @@ -767,22 +773,25 @@ TclAppendBytesToByteArray( * Try to allocate double the total space that is needed. */ - size_t attempt = 2 * needed; + Tcl_Size attempt; - /* Protection just in case we wrapped around SIZE_MAX */ - if (attempt >= needed) { + /* Make sure we do not wrap when doubling */ + if (needed <= (BYTEARRAY_MAX_LEN - needed)) { + attempt = 2 * needed; ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } + if (ptr == NULL) { /* - * Try to allocate double the increment that is needed (plus). + * Try to allocate double the increment that is needed. + * (Originally TCL_MIN_GROWTH was added as well but that would + * need one more separate overflow check so forget it.) */ - - attempt = needed + len + TCL_MIN_GROWTH; - if (attempt >= needed) { - ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr, - BYTEARRAY_SIZE(attempt)); + if (len <= (BYTEARRAY_MAX_LEN - needed)) { + attempt = needed + len; + ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, + BYTEARRAY_SIZE(attempt)); } } if (ptr == NULL) { @@ -861,7 +870,7 @@ BinaryFormatCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - size_t count; /* Count associated with current format + Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -873,7 +882,7 @@ BinaryFormatCmd( * cursor has visited.*/ const char *errorString; const char *errorValue, *str; - size_t offset, size, length; + Tcl_Size offset, size, length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); @@ -971,7 +980,7 @@ BinaryFormatCmd( arg++; count = 1; } else { - size_t listc; + Tcl_Size listc; Tcl_Obj **listv; /* @@ -1003,7 +1012,7 @@ BinaryFormatCmd( case 'x': if (count == BINARY_ALL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot use \"*\" in format string with \"x\"", TCL_INDEX_NONE)); + "cannot use \"*\" in format string with \"x\"", -1)); return TCL_ERROR; } else if (count == BINARY_NOCOUNT) { count = 1; @@ -1047,7 +1056,7 @@ BinaryFormatCmd( } /* - * Prepare the result object by preallocating the caclulated number of + * Prepare the result object by preallocating the calculated number of * bytes and filling with nulls. */ @@ -1253,7 +1262,7 @@ BinaryFormatCmd( case 'q': case 'Q': case 'f': { - size_t listc, i; + Tcl_Size listc, i; Tcl_Obj **listv; if (count == BINARY_NOCOUNT) { @@ -1294,7 +1303,7 @@ BinaryFormatCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if ((count == BINARY_ALL) || (count > (size_t)(cursor - buffer))) { + if ((count == BINARY_ALL) || (count > (cursor - buffer))) { cursor = buffer; } else { cursor -= count; @@ -1343,7 +1352,7 @@ BinaryFormatCmd( } error: - Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } @@ -1374,7 +1383,7 @@ BinaryScanCmd( int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ - size_t count; /* Count associated with current format + Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format @@ -1383,7 +1392,7 @@ BinaryScanCmd( unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; - size_t offset, size, length = 0, i; + Tcl_Size offset, size, length = 0, i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; @@ -1492,7 +1501,7 @@ BinaryScanCmd( if (count == BINARY_NOCOUNT) { count = 1; } - if (count > (size_t)(length - offset) * 8) { + if (count > (length - offset) * 8) { goto done; } } @@ -1623,7 +1632,7 @@ BinaryScanCmd( goto badIndex; } if (count == BINARY_NOCOUNT) { - if (length < (size_t)size + offset) { + if (length < size + offset) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, @@ -1724,7 +1733,7 @@ BinaryScanCmd( } error: - Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } @@ -1753,7 +1762,7 @@ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ - size_t *countPtr, /* Pointer to repeat count value. */ + Tcl_Size *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* @@ -1786,14 +1795,14 @@ GetFormatSpec( (*formatPtr)++; *countPtr = BINARY_ALL; } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */ - unsigned long count; + unsigned long long count; errno = 0; - count = strtoul(*formatPtr, (char **) formatPtr, 10); - if (errno || (count > (unsigned long) INT_MAX)) { - *countPtr = INT_MAX; + count = strtoull(*formatPtr, (char **) formatPtr, 10); + if (errno || (count > TCL_SIZE_MAX)) { + *countPtr = TCL_SIZE_MAX; } else { - *countPtr = (int) count; + *countPtr = count; } } else { *countPtr = BINARY_NOCOUNT; @@ -1808,7 +1817,7 @@ GetFormatSpec( * * This routine determines, if bytes of a number need to be re-ordered, * and returns a numeric code indicating the re-ordering to be done. - * This depends on the endiannes of the machine and the desired format. + * This depends on the endianness of the machine and the desired format. * It is in effect a table (whose contents depend on the endianness of * the system) describing whether a value needs reversing or not. Anyone * porting the code to a big-endian platform should take care to make @@ -2457,7 +2466,7 @@ BinaryEncodeHex( Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; - size_t offset = 0, count = 0; + Tcl_Size offset = 0, count = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); @@ -2506,7 +2515,7 @@ BinaryDecodeHex( unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; int i, index, value, pure = 1, strict = 0; - size_t size, cut = 0, count = 0; + Tcl_Size size, cut = 0, count = 0; int ucs4; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; @@ -2629,11 +2638,11 @@ BinaryEncode64( { Tcl_Obj *resultObj; unsigned char *data, *limit; - int maxlen = 0; + Tcl_Size maxlen = 0; const char *wrapchar = "\n"; - size_t wrapcharlen = 1; - int i, index, size, outindex = 0, purewrap = 1; - size_t offset, count = 0; + Tcl_Size wrapcharlen = 1; + int index, purewrap = 1; + Tcl_Size i, offset, size, outindex = 0, count = 0; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2649,12 +2658,12 @@ BinaryEncode64( } switch (index) { case OPT_MAXLEN: - if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { + if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "line length out of range", TCL_INDEX_NONE)); + "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; @@ -2755,12 +2764,12 @@ BinaryEncodeUu( { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int rawLength, i, bits, index; + int i, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; - size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); + Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; @@ -2782,7 +2791,7 @@ BinaryEncodeUu( } if (lineLength < 5 || lineLength > 85) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "line length out of range", TCL_INDEX_NONE)); + "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; @@ -2794,7 +2803,7 @@ BinaryEncodeUu( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; - size_t numBytes = wrapcharlen; + Tcl_Size numBytes = wrapcharlen; while (numBytes) { switch (*p) { @@ -2850,7 +2859,7 @@ BinaryEncodeUu( */ while (offset < count) { - int lineLen = count - offset; + Tcl_Size lineLen = count - offset; if (lineLen > rawLength) { lineLen = rawLength; @@ -2909,7 +2918,7 @@ BinaryDecodeUu( unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; int i, index, pure = 1, strict = 0, lineLen; - size_t size, count = 0; + Tcl_Size size, count = 0; unsigned char c; int ucs4; enum { OPT_STRICT }; @@ -3085,7 +3094,7 @@ BinaryDecode64( unsigned char *cursor = NULL; int pure = 1, strict = 0; int i, index, cut = 0; - size_t size, count = 0; + Tcl_Size size, count = 0; int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 6f3194044f99..09e140a7b2a0 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -172,7 +172,7 @@ TclDumpMemoryInfo( if (clientData == NULL) { return 0; } - sprintf(buf, + snprintf(buf, sizeof(buf), "total mallocs %10" TCL_Z_MODIFIER "u\n" "total frees %10" TCL_Z_MODIFIER "u\n" "current packets allocated %10" TCL_Z_MODIFIER "u\n" @@ -189,7 +189,7 @@ TclDumpMemoryInfo( fprintf((FILE *)clientData, "%s", buf); } else { /* Assume objPtr to append to */ - Tcl_AppendToObj((Tcl_Obj *) clientData, buf, TCL_INDEX_NONE); + Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1); } return 1; } diff --git a/generic/tclClock.c b/generic/tclClock.c index 1d33886e8e17..a54e36b27b0c 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -143,17 +143,17 @@ TCL_DECLARE_MUTEX(clockMutex) static int ConvertUTCToLocal(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, - TclDateFields *, size_t, Tcl_Obj *const[]); + TclDateFields *, Tcl_Size, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); static int ConvertLocalToUTC(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, - TclDateFields *, size_t, Tcl_Obj *const[]); + TclDateFields *, Tcl_Size, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, - size_t, Tcl_Obj *const *); + Tcl_Size, Tcl_Obj *const *); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); @@ -728,7 +728,7 @@ ConvertLocalToUTC( Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - size_t rowc; /* Number of rows in tzdata */ + Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* @@ -773,11 +773,11 @@ static int ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ - size_t rowc, /* Number of points at which time changes */ + Tcl_Size rowc, /* Number of points at which time changes */ Tcl_Obj *const rowv[]) /* Points at which time changes */ { Tcl_Obj *row; - size_t cellc; + Tcl_Size cellc; Tcl_Obj **cellv; int have[8]; int nHave = 0; @@ -931,7 +931,7 @@ ConvertUTCToLocal( Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { - size_t rowc; /* Number of rows in tzdata */ + Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* @@ -976,12 +976,12 @@ static int ConvertUTCToLocalUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the date */ - size_t rowc, /* Number of rows in the conversion table + Tcl_Size rowc, /* Number of rows in the conversion table * (>= 1) */ Tcl_Obj *const rowv[]) /* Rows of the conversion table */ { Tcl_Obj *row; /* Row containing the current information */ - size_t cellc; /* Count of cells in the row (must be 4) */ + Tcl_Size cellc; /* Count of cells in the row (must be 4) */ Tcl_Obj **cellv; /* Pointers to the cells */ /* @@ -1086,12 +1086,12 @@ ConvertUTCToLocalUsingC( } else { *buffer = '+'; } - sprintf(buffer+1, "%02d", diff / 3600); + snprintf(buffer+1, sizeof(buffer) - 1, "%02d", diff / 3600); diff %= 3600; - sprintf(buffer+3, "%02d", diff / 60); + snprintf(buffer+3, sizeof(buffer) - 3, "%02d", diff / 60); diff %= 60; if (diff > 0) { - sprintf(buffer+5, "%02d", diff); + snprintf(buffer+5, sizeof(buffer) - 5, "%02d", diff); } fields->tzName = Tcl_NewStringObj(buffer, -1); Tcl_IncrRefCount(fields->tzName); @@ -1116,11 +1116,11 @@ static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ - size_t rowc, /* Number of rows of tzdata */ + Tcl_Size rowc, /* Number of rows of tzdata */ Tcl_Obj *const *rowv) /* Rows in tzdata */ { - size_t l; - size_t u; + Tcl_Size l; + Tcl_Size u; Tcl_Obj *compObj; Tcl_WideInt compVal; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 5dbadb818e3e..e2186ed401fc 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -27,14 +27,14 @@ struct ForeachState { Tcl_Obj *bodyPtr; /* The script body of the command. */ - int bodyIdx; /* The argument index of the body. */ - int j, maxj; /* Number of loop iterations. */ - int numLists; /* Count of value lists. */ - size_t *index; /* Array of value list indices. */ - size_t *varcList; /* # loop variables per list. */ + Tcl_Size bodyIdx; /* The argument index of the body. */ + Tcl_Size j, maxj; /* Number of loop iterations. */ + Tcl_Size numLists; /* Count of value lists. */ + Tcl_Size *index; /* Array of value list indices. */ + Tcl_Size *varcList; /* # loop variables per list. */ Tcl_Obj ***varvList; /* Array of var name lists. */ Tcl_Obj **vCopyList; /* Copies of var name list arguments. */ - size_t *argcList; /* Array of value list sizes. */ + Tcl_Size *argcList; /* Array of value list sizes. */ Tcl_Obj ***argvList; /* Array of value lists. */ Tcl_Obj **aCopyList; /* Copies of value list arguments. */ Tcl_Obj *resultList; /* List of result values from the loop body, @@ -530,7 +530,7 @@ EncodingConvertfromObjCmd( Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ - size_t length = 0; /* Length of the byte array being converted */ + Tcl_Size length = 0; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ int flags; int result; @@ -630,7 +630,7 @@ EncodingConverttoObjCmd( Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ - size_t length; /* Length of the string being converted */ + Tcl_Size length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ int result; int flags; @@ -2064,7 +2064,7 @@ PathSplitCmd( Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } - res = Tcl_FSSplitPath(objv[1], (size_t *)NULL); + res = Tcl_FSSplitPath(objv[1], NULL); if (res == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", @@ -2733,7 +2733,8 @@ EachloopCmd( { int numLists = (objc-2) / 2; struct ForeachState *statePtr; - int i, j, result; + int i, result; + Tcl_Size j; if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -2757,16 +2758,16 @@ EachloopCmd( */ statePtr = (struct ForeachState *)TclStackAlloc(interp, - sizeof(struct ForeachState) + 3 * numLists * sizeof(size_t) + sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, - sizeof(struct ForeachState) + 3 * numLists * sizeof(size_t) + sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); statePtr->varvList = (Tcl_Obj ***) (statePtr + 1); statePtr->argvList = statePtr->varvList + numLists; statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists); statePtr->aCopyList = statePtr->vCopyList + numLists; - statePtr->index = (size_t *) (statePtr->aCopyList + numLists); + statePtr->index = (Tcl_Size *) (statePtr->aCopyList + numLists); statePtr->varcList = statePtr->index + numLists; statePtr->argcList = statePtr->varcList + numLists; @@ -2887,8 +2888,12 @@ ForeachLoopStep( break; case TCL_OK: if (statePtr->resultList != NULL) { - Tcl_ListObjAppendElement(interp, statePtr->resultList, - Tcl_GetObjResult(interp)); + result = Tcl_ListObjAppendElement( + interp, statePtr->resultList, Tcl_GetObjResult(interp)); + if (result != TCL_OK) { + /* e.g. memory alloc failure on big data tests */ + goto done; + } } break; case TCL_BREAK: @@ -2946,7 +2951,7 @@ ForeachAssignments( struct ForeachState *statePtr) { int i; - size_t v, k; + Tcl_Size v, k; Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; inumLists ; i++) { diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index e1949a5cdecd..7beb60a29d24 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -51,7 +51,7 @@ typedef struct SortElement { */ typedef int (*SortStrCmpFn_t) (const char *, const char *); -typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); +typedef int (*SortMemCmpFn_t) (const void *, const void *, Tcl_Size); /* * The "lsort" command needs to pass certain information down to the function @@ -65,7 +65,7 @@ typedef struct { int sortMode; /* The sort mode. One of SORTMODE_* values * defined below. */ Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is - * SORTMODE_COMMAND. Pre-initialized to hold + * SORTMODE_COMMAND. Preinitialized to hold * base of command. */ int *indexv; /* If the -index option was specified, this * holds an encoding of the indexes contained @@ -74,7 +74,7 @@ typedef struct { * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ - size_t indexc; /* Number of indexes in indexv array. */ + Tcl_Size indexc; /* Number of indexes in indexv array. */ int singleIndex; /* Static space for common index case. */ int unique; int numElements; @@ -504,7 +504,7 @@ InfoArgsCmd( localPtr = localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_ListObjAppendElement(interp, listObjPtr, - Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(localPtr->name, -1)); } } Tcl_SetObjResult(interp, listObjPtr); @@ -541,7 +541,7 @@ InfoBodyCmd( Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; - size_t numBytes; + Tcl_Size numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); @@ -651,7 +651,7 @@ InfoCommandsCmd( Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; - size_t i; + Tcl_Size i; /* * Get the pattern and find the "effective namespace" in which to list @@ -716,7 +716,7 @@ InfoCommandsCmd( Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); - elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); Tcl_SetObjResult(interp, listPtr); @@ -744,7 +744,7 @@ InfoCommandsCmd( if (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(cmdName, TCL_INDEX_NONE)); + Tcl_NewStringObj(cmdName, -1)); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } @@ -766,7 +766,7 @@ InfoCommandsCmd( elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { - elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } @@ -789,7 +789,7 @@ InfoCommandsCmd( || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(cmdName, TCL_INDEX_NONE)); + Tcl_NewStringObj(cmdName, -1)); } } entryPtr = Tcl_NextHashEntry(&search); @@ -818,7 +818,7 @@ InfoCommandsCmd( cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); @@ -844,7 +844,7 @@ InfoCommandsCmd( cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); if (isNew) { @@ -871,7 +871,7 @@ InfoCommandsCmd( cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); if (Tcl_FindHashEntry(&addedCommandsTable, (char *) elemObjPtr) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); @@ -1291,7 +1291,7 @@ TclInfoFrame( * str. */ - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], TCL_INDEX_NONE)); + ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); if (framePtr->line) { ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0])); } else { @@ -1305,7 +1305,7 @@ TclInfoFrame( * Precompiled. Result contains the type as signal, nothing else. */ - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], TCL_INDEX_NONE)); + ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); break; case TCL_LOCATION_BC: { @@ -1330,7 +1330,7 @@ TclInfoFrame( * Possibly modified: type, path! */ - ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], TCL_INDEX_NONE)); + ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1)); if (fPtr->line) { ADD_PAIR("line", Tcl_NewWideIntObj(fPtr->line[0])); } @@ -1358,7 +1358,7 @@ TclInfoFrame( * Evaluation of a script file. */ - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], TCL_INDEX_NONE)); + ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0])); ADD_PAIR("file", framePtr->data.eval.path); @@ -1396,7 +1396,7 @@ TclInfoFrame( ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; - size_t i; + Tcl_Size i; /* * This is a non-standard command. Luckily, it's told us how to @@ -1404,7 +1404,7 @@ TclInfoFrame( */ for (i=0 ; ilength ; i++) { - lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, TCL_INDEX_NONE); + lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); if (efiPtr->fields[i].proc) { lv[lc++] = efiPtr->fields[i].proc(efiPtr->fields[i].clientData); @@ -1492,7 +1492,7 @@ InfoFunctionsCmd( " }\n" " }\n" " ::return $cmds\n" -" } [::namespace current]] ", TCL_INDEX_NONE); +" } [::namespace current]] ", -1); if (objc == 2) { Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1])); @@ -1545,12 +1545,12 @@ InfoHostnameCmd( name = Tcl_GetHostName(); if (name) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(name, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to determine name of host", TCL_INDEX_NONE)); + "unable to determine name of host", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL); return TCL_ERROR; } @@ -1665,12 +1665,12 @@ InfoLibraryCmd( libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); if (libDirName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no library has been specified for Tcl", TCL_INDEX_NONE)); + "no library has been specified for Tcl", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL); return TCL_ERROR; } @@ -1797,7 +1797,7 @@ InfoPatchLevelCmd( patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1)); return TCL_OK; } return TCL_ERROR; @@ -1910,7 +1910,7 @@ InfoProcsCmd( Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { - elemObjPtr = Tcl_NewStringObj(simplePattern, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } @@ -1938,7 +1938,7 @@ InfoProcsCmd( Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { - elemObjPtr = Tcl_NewStringObj(cmdName, TCL_INDEX_NONE); + elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } @@ -1977,7 +1977,7 @@ InfoProcsCmd( if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(cmdName, TCL_INDEX_NONE)); + Tcl_NewStringObj(cmdName, -1)); } } } @@ -2075,7 +2075,7 @@ InfoSharedlibCmd( } #ifdef TCL_SHLIB_EXT - Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1)); #endif return TCL_OK; } @@ -2172,7 +2172,7 @@ InfoCmdTypeCmd( Tcl_AppendResult(interp, "native", NULL); } else { Tcl_SetObjResult(interp, - Tcl_NewStringObj(TclGetCommandTypeName(command), TCL_INDEX_NONE)); + Tcl_NewStringObj(TclGetCommandTypeName(command), -1)); } return TCL_OK; } @@ -2201,7 +2201,7 @@ Tcl_JoinObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - size_t length, listLen; + Tcl_Size length, listLen; int isArithSeries = 0; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; @@ -2250,7 +2250,7 @@ Tcl_JoinObjCmd( if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { - size_t i; + Tcl_Size i; resObjPtr = Tcl_NewObj(); if (isArithSeries) { @@ -2272,6 +2272,7 @@ Tcl_JoinObjCmd( return TCL_ERROR; } Tcl_AppendObjToObj(resObjPtr, valueObj); + Tcl_DecrRefCount(valueObj); } } else { for (i = 0; i < listLen; i++) { @@ -2324,7 +2325,8 @@ Tcl_LassignObjCmd( { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ - size_t listObjc; /* The length of the list. */ + Tcl_Size listObjc; /* The length of the list. */ + Tcl_Size origListObjc; /* Original length */ int code = TCL_OK; if (objc < 2) { @@ -2336,8 +2338,10 @@ Tcl_LassignObjCmd( if (listCopyPtr == NULL) { return TCL_ERROR; } + Tcl_IncrRefCount(listCopyPtr); /* Important! fs */ TclListObjGetElementsM(NULL, listCopyPtr, &listObjc, &listObjv); + origListObjc = listObjc; objc -= 2; objv += 2; @@ -2365,7 +2369,13 @@ Tcl_LassignObjCmd( } if (code == TCL_OK && listObjc > 0) { - Tcl_SetObjResult(interp, Tcl_NewListObj(listObjc, listObjv)); + Tcl_Obj *resultObjPtr = TclListObjRange( + interp, listCopyPtr, origListObjc - listObjc, origListObjc - 1); + if (resultObjPtr == NULL) { + code = TCL_ERROR; + } else { + Tcl_SetObjResult(interp, resultObjPtr); + } } Tcl_DecrRefCount(listCopyPtr); @@ -2455,7 +2465,7 @@ Tcl_LinsertObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; - size_t len, index; + Tcl_Size len, index; int result; if (objc < 3) { @@ -2478,7 +2488,7 @@ Tcl_LinsertObjCmd( if (result != TCL_OK) { return result; } - if (index + 1 > len + 1) { + if (index > len) { index = len; } @@ -2574,7 +2584,7 @@ Tcl_LlengthObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t listLen; + Tcl_Size listLen; int result; Tcl_Obj *objPtr; @@ -2623,7 +2633,7 @@ Tcl_LpopObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t listLen; + Tcl_Size listLen; int result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; @@ -2652,7 +2662,7 @@ Tcl_LpopObjCmd( if (!listLen) { /* empty list, throw the same error as with index "end" */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "index \"end\" out of range", TCL_INDEX_NONE)); + "index \"end\" out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", NULL); return TCL_ERROR; @@ -2726,7 +2736,7 @@ Tcl_LrangeObjCmd( /* Argument objects. */ { int result; - size_t listLen, first, last; + Tcl_Size listLen, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; @@ -2758,7 +2768,11 @@ Tcl_LrangeObjCmd( return TCL_ERROR; } } else { - Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); + Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last); + if (resultObj == NULL) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, resultObj); } return TCL_OK; } @@ -2785,8 +2799,8 @@ LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { - size_t idx1 = *((const size_t *) el1Ptr); - size_t idx2 = *((const size_t *) el2Ptr); + Tcl_Size idx1 = *((const Tcl_Size *) el1Ptr); + Tcl_Size idx2 = *((const Tcl_Size *) el2Ptr); /* * This will put the larger element first. @@ -2802,8 +2816,8 @@ Tcl_LremoveObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, idxc, prevIdx, first, num; - size_t *idxv, listLen; + Tcl_Size i, idxc, prevIdx, first, num; + Tcl_Size *idxv, listLen; Tcl_Obj *listObj; /* @@ -2825,7 +2839,7 @@ Tcl_LremoveObjCmd( Tcl_SetObjResult(interp, listObj); return TCL_OK; } - idxv = (size_t *)Tcl_Alloc((objc - 2) * sizeof(size_t)); + idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv)); for (i = 2; i < objc; i++) { if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, &idxv[i - 2]) != TCL_OK) { @@ -2840,7 +2854,7 @@ Tcl_LremoveObjCmd( */ if (idxc > 1) { - qsort(idxv, idxc, sizeof(size_t), LremoveIndexCompare); + qsort(idxv, idxc, sizeof(*idxv), LremoveIndexCompare); } /* @@ -2853,7 +2867,7 @@ Tcl_LremoveObjCmd( num = 0; first = listLen; for (i = 0, prevIdx = -1 ; i < idxc ; i++) { - int idx = idxv[i]; + Tcl_Size idx = idxv[i]; /* * Repeated index and sanity check. @@ -2863,7 +2877,7 @@ Tcl_LremoveObjCmd( continue; } prevIdx = idx; - if (idx < 0 || idx >= (int)listLen) { + if (idx < 0 || idx >= listLen) { continue; } @@ -2922,7 +2936,7 @@ Tcl_LrepeatObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { - int elementCount, i, totalElems; + Tcl_Size elementCount, i, totalElems; Tcl_Obj *listPtr, **dataArray = NULL; /* @@ -2934,12 +2948,12 @@ Tcl_LrepeatObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?"); return TCL_ERROR; } - if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) { + if (TCL_OK != TclGetSizeIntFromObj(interp, objv[1], &elementCount)) { return TCL_ERROR; } if (elementCount < 0) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad count \"%d\": must be integer >= 0", elementCount)); + "bad count \"%" TCL_SIZE_MODIFIER "d\": must be integer >= 0", elementCount)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", NULL); return TCL_ERROR; @@ -2954,9 +2968,9 @@ Tcl_LrepeatObjCmd( /* Final sanity check. Do not exceed limits on max list length. */ - if (elementCount && (size_t)objc > LIST_MAX/elementCount) { + if (elementCount && objc > LIST_MAX/elementCount) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max length of a Tcl list (%" TCL_Z_MODIFIER "u elements) exceeded", LIST_MAX)); + "max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } @@ -2996,7 +3010,7 @@ Tcl_LrepeatObjCmd( dataArray[i] = tmpPtr; } } else { - int j, k = 0; + Tcl_Size j, k = 0; for (i=0 ; i listLen) { first = listLen; } - if (last + 1 > listLen) { + if (last >= listLen) { last = listLen - 1; } - if (first + 1 <= last + 1) { + if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0; @@ -3137,7 +3151,7 @@ Tcl_LreverseObjCmd( Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; - size_t elemc, i, j; + Tcl_Size elemc, i, j; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); @@ -3242,8 +3256,9 @@ Tcl_LsearchObjCmd( Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; - int match, index, result=TCL_OK, bisect; - size_t i, length = 0, listc, elemLen, start, groupSize, groupOffset, lower, upper; + int match, result=TCL_OK, bisect; + Tcl_Size i, length = 0, listc, elemLen, start, index; + Tcl_Size groupSize, groupOffset, lower, upper; int allocatedIndexVector = 0; int isIncreasing; Tcl_WideInt patWide, objWide, wide; @@ -3302,7 +3317,7 @@ Tcl_LsearchObjCmd( return TCL_ERROR; } - for (i = 1; i < (size_t)objc-2; i++) { + for (i = 1; i < objc-2; i++) { enum lsearchoptions idx; if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx) != TCL_OK) { @@ -3372,9 +3387,9 @@ Tcl_LsearchObjCmd( Tcl_DecrRefCount(startPtr); startPtr = NULL; } - if (i + 4 > (size_t)objc) { + if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing starting index", TCL_INDEX_NONE)); + "missing starting index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; @@ -3395,10 +3410,10 @@ Tcl_LsearchObjCmd( Tcl_IncrRefCount(startPtr); break; case LSEARCH_STRIDE: /* -stride */ - if (i + 4 > (size_t)objc) { + if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-stride\" option must be " - "followed by stride length", TCL_INDEX_NONE)); + "followed by stride length", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; @@ -3409,7 +3424,7 @@ Tcl_LsearchObjCmd( } if (wide < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "stride length must be at least 1", TCL_INDEX_NONE)); + "stride length must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", NULL); result = TCL_ERROR; @@ -3420,13 +3435,13 @@ Tcl_LsearchObjCmd( break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; - size_t j; + Tcl_Size j; if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); allocatedIndexVector = 0; } - if (i + 4 > (size_t)objc) { + if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); @@ -3499,7 +3514,7 @@ Tcl_LsearchObjCmd( if (returnSubindices && sortInfo.indexc==0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-subindices cannot be used without -index option", TCL_INDEX_NONE)); + "-subindices cannot be used without -index option", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); result = TCL_ERROR; @@ -3508,7 +3523,7 @@ Tcl_LsearchObjCmd( if (bisect && (allMatches || negatedMatch)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-bisect is not compatible with -all or -not", TCL_INDEX_NONE)); + "-bisect is not compatible with -all or -not", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); result = TCL_ERROR; @@ -3575,10 +3590,10 @@ Tcl_LsearchObjCmd( */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); - if (groupOffset >= groupSize) { + if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" - " value must be within the group", TCL_INDEX_NONE)); + " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADINDEX", NULL); result = TCL_ERROR; @@ -3615,7 +3630,7 @@ Tcl_LsearchObjCmd( * "did not match anything at all" result straight away. [Bug 1374778] */ - if (start >= (size_t)listc) { + if (start >= listc) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { @@ -3906,7 +3921,7 @@ Tcl_LsearchObjCmd( Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } } else if (returnSubindices) { - size_t j; + Tcl_Size j; TclNewIndexObj(itemPtr, i+groupOffset); for (j=0 ; j= groupSize) { + if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" - " value must be within the group", TCL_INDEX_NONE)); + " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADINDEX", NULL); sortInfo.resultCode = TCL_ERROR; @@ -4893,7 +4908,7 @@ Tcl_LsortObjCmd( } /* - * Merge this element in the pre-existing sublists (and merge together + * Merge this element in the preexisting sublists (and merge together * sublists when we have two of the same size). */ @@ -5012,10 +5027,10 @@ Tcl_LeditObjCmd( Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ int createdNewObj; int result; - size_t first; - size_t last; - size_t listLen; - size_t numToDelete; + Tcl_Size first; + Tcl_Size last; + Tcl_Size listLen; + Tcl_Size numToDelete; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -5048,17 +5063,17 @@ Tcl_LeditObjCmd( return result; } - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = 0; } else if (first > listLen) { first = listLen; } /* The +1 in comparisons are necessitated by indices being unsigned */ - if ((last + 1) > listLen) { + if (last >= listLen) { last = listLen - 1; } - if ((first + 1) <= (last + 1)) { + if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0; @@ -5211,7 +5226,7 @@ MergeLists( * ordering between two elements. * * Results: - * A negative results means the the first element comes before the + * A negative results means the first element comes before the * second, and a positive results means that the second element should * come first. A result of zero means the two elements are equal and it * doesn't matter which comes first. @@ -5254,7 +5269,7 @@ SortCompare( order = ((a >= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; - size_t objc; + Tcl_Size objc; Tcl_Obj *objPtr1, *objPtr2; if (infoPtr->resultCode != TCL_OK) { @@ -5298,7 +5313,7 @@ SortCompare( if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( - "-compare command returned non-integer result", TCL_INDEX_NONE)); + "-compare command returned non-integer result", -1)); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "COMPARISONFAILED", NULL); infoPtr->resultCode = TCL_ERROR; @@ -5413,7 +5428,7 @@ DictionaryCompare( /* * Convert both chars to lower for the comparison, because - * dictionary sorts are case insensitve. Covert to lower, not + * dictionary sorts are case-insensitive. Covert to lower, not * upper, so chars between Z and a will sort before A (where most * other interesting punctuations occur). */ @@ -5472,7 +5487,7 @@ SelectObjFromSublist( SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { - size_t i; + Tcl_Size i; /* * Quick check for case when no "-index" option is there. @@ -5488,7 +5503,7 @@ SelectObjFromSublist( */ for (i=0 ; iindexc ; i++) { - size_t listLen; + Tcl_Size listLen; int index; Tcl_Obj *currentObj; @@ -5505,7 +5520,7 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - if (index == (int)TCL_INDEX_NONE) { + if (index == TCL_INDEX_NONE) { index = TCL_INDEX_END - infoPtr->indexv[i]; Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( "element end-%d missing from sublist \"%s\"", diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 77c8cb48f2e3..a4e999cb660d 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -128,7 +128,7 @@ Tcl_RegexpObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t offset, stringLength, matchLength, cflags, eflags; + Tcl_Size offset, stringLength, matchLength, cflags, eflags; int i, indices, match, about, all, doinline, numMatchesSaved; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; @@ -191,11 +191,11 @@ Tcl_RegexpObjCmd( cflags |= TCL_REG_NLANCH; break; case REGEXP_START: { - size_t temp; + Tcl_Size temp; if (++i >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[i], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[i], TCL_SIZE_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { @@ -227,7 +227,7 @@ Tcl_RegexpObjCmd( if (doinline && ((objc - 2) != 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "regexp match variables not allowed when using -inline", TCL_INDEX_NONE)); + "regexp match variables not allowed when using -inline", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP", "MIX_VAR_INLINE", NULL); goto optionError; @@ -261,7 +261,7 @@ Tcl_RegexpObjCmd( if (startIndex) { TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); - if (offset == TCL_INDEX_NONE) { + if (offset < 0) { offset = TCL_INDEX_START; } } @@ -308,7 +308,7 @@ Tcl_RegexpObjCmd( if (offset == TCL_INDEX_START) { eflags = 0; - } else if (offset + 1 > stringLength + 1) { + } else if (offset > stringLength) { eflags = TCL_REG_NOTBOL; } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; @@ -364,7 +364,7 @@ Tcl_RegexpObjCmd( Tcl_Obj *newPtr; if (indices) { - size_t start, end; + Tcl_Size start, end; Tcl_Obj *objs[2]; /* @@ -372,7 +372,7 @@ Tcl_RegexpObjCmd( * area. (Scriptics Bug 4391/SF Bug #219232) */ - if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) { + if (i <= (int)info.nsubs && info.matches[i].start >= 0) { start = offset + info.matches[i].start; end = offset + info.matches[i].end; @@ -381,7 +381,7 @@ Tcl_RegexpObjCmd( * match instead of the first character after the match. */ - if (end + 1 >= offset + 1) { + if (end >= offset) { end--; } } else { @@ -394,7 +394,7 @@ Tcl_RegexpObjCmd( newPtr = Tcl_NewListObj(2, objs); } else { - if ((i <= (int)info.nsubs) && (info.matches[i].end + 1 > 1)) { + if ((i <= (int)info.nsubs) && (info.matches[i].end > 0)) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); @@ -427,7 +427,7 @@ Tcl_RegexpObjCmd( * match. We always increment the offset by at least one to prevent * endless looping (as in the case: regexp -all {a*} a). Otherwise, * when we match the NULL string at the end of the input string, we - * will loop indefinately (because the length of the match is 0, so + * will loop indefinitely (because the length of the match is 0, so * offset never changes). */ @@ -444,7 +444,7 @@ Tcl_RegexpObjCmd( offset++; } all++; - if (offset + 1 >= stringLength + 1) { + if (offset >= stringLength) { break; } } @@ -488,8 +488,8 @@ Tcl_RegsubObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int result, cflags, all, match, command; - size_t idx, wlen, wsublen = 0, offset, numMatches, numParts; - size_t start, end, subStart, subEnd; + Tcl_Size idx, wlen, wsublen = 0, offset, numMatches, numParts; + Tcl_Size start, end, subStart, subEnd; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; @@ -512,7 +512,7 @@ Tcl_RegsubObjCmd( command = 0; resultPtr = NULL; - for (idx = 1; idx < (size_t)objc; idx++) { + for (idx = 1; idx < objc; idx++) { const char *name; name = TclGetString(objv[idx]); @@ -546,11 +546,11 @@ Tcl_RegsubObjCmd( cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { - size_t temp; - if (++idx >= (size_t)objc) { + Tcl_Size temp; + if (++idx >= objc) { goto endOfForLoop; } - if (TclGetIntForIndexM(interp, objv[idx], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) { + if (TclGetIntForIndexM(interp, objv[idx], TCL_SIZE_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { @@ -567,7 +567,7 @@ Tcl_RegsubObjCmd( } endOfForLoop: - if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) { + if (objc < idx + 3 || objc > idx + 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string subSpec ?varName?"); optionError: @@ -581,16 +581,16 @@ Tcl_RegsubObjCmd( objv += idx; if (startIndex) { - size_t stringLength = Tcl_GetCharLength(objv[1]); + Tcl_Size stringLength = Tcl_GetCharLength(objv[1]); TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); - if (offset == TCL_INDEX_NONE) { - offset = TCL_INDEX_START; + if (offset < 0) { + offset = 0; } } - if (all && (offset == TCL_INDEX_START) && (command == 0) + if (all && (offset == 0) && (command == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { /* @@ -598,7 +598,7 @@ Tcl_RegsubObjCmd( * slightly modified version of the one pair STR_MAP code. */ - size_t slen; + Tcl_Size slen; int nocase, wsrclc; int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; @@ -774,7 +774,7 @@ Tcl_RegsubObjCmd( if (command) { Tcl_Obj **args = NULL, **parts; - size_t numArgs; + Tcl_Size numArgs; TclListObjGetElementsM(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; @@ -784,7 +784,7 @@ Tcl_RegsubObjCmd( for (idx = 0 ; idx <= info.nsubs ; idx++) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { + if ((subStart >= 0) && (subEnd >= 0)) { args[idx + numParts] = Tcl_NewUnicodeObj( wstring + offset + subStart, subEnd - subStart); } else { @@ -888,7 +888,7 @@ Tcl_RegsubObjCmd( if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; - if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) { + if ((subStart >= 0) && (subEnd >= 0)) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } @@ -1179,7 +1179,7 @@ Tcl_SplitObjCmd( const char *splitChars; const char *stringPtr; const char *end; - size_t splitCharLen, stringLen; + Tcl_Size splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { @@ -1239,7 +1239,7 @@ Tcl_SplitObjCmd( /* * Handle the special case of splitting on a single character. This is - * only true for the one-char ASCII case, as one unicode char is > 1 + * only true for the one-char ASCII case, as one Unicode char is > 1 * byte in length. */ @@ -1252,7 +1252,7 @@ Tcl_SplitObjCmd( Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; - size_t splitLen; + Tcl_Size splitLen; int splitChar; /* @@ -1307,7 +1307,7 @@ StringFirstCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t start = TCL_INDEX_START; + Tcl_Size start = TCL_INDEX_START; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1316,7 +1316,7 @@ StringFirstCmd( } if (objc == 4) { - size_t end = Tcl_GetCharLength(objv[2]) - 1; + Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1; if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) { return TCL_ERROR; @@ -1351,7 +1351,7 @@ StringLastCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t last = TCL_INDEX_END; + Tcl_Size last = TCL_SIZE_MAX; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1360,7 +1360,7 @@ StringLastCmd( } if (objc == 4) { - size_t end = Tcl_GetCharLength(objv[2]) - 1; + Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1; if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) { return TCL_ERROR; @@ -1395,7 +1395,7 @@ StringIndexCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t index, end; + Tcl_Size index, end; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string charIndex"); @@ -1411,7 +1411,7 @@ StringIndexCmd( return TCL_ERROR; } - if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) { + if ((index >= 0) && (index <= end)) { int ch = Tcl_GetUniChar(objv[1], index); if (ch == -1) { @@ -1467,8 +1467,8 @@ StringInsertCmd( int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { - size_t length; /* String length */ - size_t index; /* Insert index */ + Tcl_Size length; /* String length */ + Tcl_Size index; /* Insert index */ Tcl_Obj *outObj; /* Output object */ if (objc != 4) { @@ -1481,7 +1481,7 @@ StringInsertCmd( return TCL_ERROR; } - if (index == TCL_INDEX_NONE) { + if (index < 0) { index = TCL_INDEX_START; } if (index > length) { @@ -1527,7 +1527,7 @@ StringIsCmd( const char *string1, *end, *stop; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ int i, result = 1, strict = 0; - size_t failat = 0, length1, length2, length3; + Tcl_Size failat = 0, length1, length2, length3; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; @@ -1589,7 +1589,7 @@ StringIsCmd( /* * We get the objPtr so that we can short-cut for some classes by checking * the object type (int and double), but we need the string otherwise, - * because we don't want any conversion of type occuring (as, for example, + * because we don't want any conversion of type occurring (as, for example, * Tcl_Get*FromObj would do). */ @@ -1630,7 +1630,7 @@ StringIsCmd( break; case STR_IS_DICT: { int dresult; - size_t dsize; + Tcl_Size dsize; dresult = Tcl_DictObjSize(interp, objPtr, &dsize); Tcl_ResetResult(interp); @@ -1643,8 +1643,7 @@ StringIsCmd( */ const char *elemStart, *nextElem; - int lenRemain; - size_t elemSize; + Tcl_Size lenRemain, elemSize; const char *p; string1 = Tcl_GetStringFromObj(objPtr, &length1); @@ -1824,8 +1823,8 @@ StringIsCmd( */ const char *elemStart, *nextElem; - size_t lenRemain; - size_t elemSize; + Tcl_Size lenRemain; + Tcl_Size elemSize; const char *p; string1 = Tcl_GetStringFromObj(objPtr, &length1); @@ -1960,7 +1959,7 @@ StringMapCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2, mapElemc, index; + Tcl_Size length1, length2, mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; @@ -1993,7 +1992,7 @@ StringMapCmd( if (!TclHasStringRep(objv[objc-2]) && TclHasInternalRep(objv[objc-2], &tclDictType)) { - size_t i; + Tcl_Size i; int done; Tcl_DictSearch search; @@ -2028,7 +2027,7 @@ StringMapCmd( } Tcl_DictObjDone(&search); } else { - size_t i; + Tcl_Size i; if (TclListObjGetElementsM(interp, objv[objc-2], &i, &mapElemv) != TCL_OK) { return TCL_ERROR; @@ -2047,7 +2046,7 @@ StringMapCmd( */ Tcl_SetObjResult(interp, - Tcl_NewStringObj("char map list unbalanced", TCL_INDEX_NONE)); + Tcl_NewStringObj("char map list unbalanced", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP", "UNBALANCED", NULL); return TCL_ERROR; @@ -2091,7 +2090,7 @@ StringMapCmd( * larger strings. */ - size_t mapLen; + Tcl_Size mapLen; int u2lc; Tcl_UniChar *mapString; @@ -2125,18 +2124,18 @@ StringMapCmd( } } else { Tcl_UniChar **mapStrings; - size_t *mapLens; + Tcl_Size *mapLens; int *u2lc = 0; /* - * Precompute pointers to the unicode string and length. This saves us + * Precompute pointers to the Unicode string and length. This saves us * repeated function calls later, significantly speeding up the * algorithm. We only need the lowercase first char in the nocase * case. */ mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); - mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2); + mapLens = (Tcl_Size *)TclStackAlloc(interp, mapElemc * sizeof(Tcl_Size) * 2); if (nocase) { u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int)); } @@ -2158,7 +2157,7 @@ StringMapCmd( if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ - ((size_t)(end-ustring1) >= length2) && ((length2 == 1) || + ((end-ustring1) >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* @@ -2178,7 +2177,7 @@ StringMapCmd( ustring1 = p - 1; /* - * Append the map value to the unicode string. + * Append the map value to the Unicode string. */ Tcl_AppendUnicodeToObj(resultPtr, @@ -2244,7 +2243,7 @@ StringMatchCmd( } if (objc == 4) { - size_t length; + Tcl_Size length; const char *string = Tcl_GetStringFromObj(objv[1], &length); if ((length > 1) && @@ -2288,7 +2287,7 @@ StringRangeCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t first, last, end; + Tcl_Size first, last, end; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string first last"); @@ -2307,7 +2306,7 @@ StringRangeCmd( return TCL_ERROR; } - if (last != TCL_INDEX_NONE) { + if (last >= 0) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; @@ -2394,7 +2393,7 @@ StringRplcCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t first, last, end; + Tcl_Size first, last, end; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?"); @@ -2414,9 +2413,9 @@ StringRplcCmd( * result is the original string. */ - if ((last == TCL_INDEX_NONE) || /* Range ends before start of string */ - (first + 1 > end + 1) || /* Range begins after end of string */ - (last + 1 < first + 1)) { /* Range begins after it starts */ + if ((last < 0) || /* Range ends before start of string */ + (first > end) || /* Range begins after end of string */ + (last < first)) { /* Range begins after it starts */ /* * BUT!!! when (end < 0) -- an empty original string -- we can * have (first <= end < 0 <= last) and an empty string is permitted @@ -2427,10 +2426,10 @@ StringRplcCmd( } else { Tcl_Obj *resultPtr; - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = TCL_INDEX_START; } - if (last + 1 > end + 1) { + if (last > end) { last = end; } @@ -2506,7 +2505,7 @@ StringStartCmd( { int ch; const Tcl_UniChar *p, *string; - size_t cur, index, length; + Tcl_Size cur, index, length; Tcl_Obj *obj; if (objc != 3) { @@ -2518,11 +2517,11 @@ StringStartCmd( if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } - if (index + 1 >= length + 1) { + if (index >= length) { index = length - 1; } cur = 0; - if (index + 1 > 1) { + if (index > 0) { p = &string[index]; (void)TclUniCharToUCS4(p, &ch); @@ -2576,7 +2575,7 @@ StringEndCmd( { int ch; const Tcl_UniChar *p, *end, *string; - size_t cur, index, length; + Tcl_Size cur, index, length; Tcl_Obj *obj; if (objc != 3) { @@ -2588,10 +2587,10 @@ StringEndCmd( if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } - if (index == TCL_INDEX_NONE) { - index = TCL_INDEX_START; + if (index < 0) { + index = 0; } - if (index + 1 <= length + 1) { + if (index < length) { p = &string[index]; end = string+length; for (cur = index; p < end; cur++) { @@ -2643,8 +2642,8 @@ StringEqualCmd( */ const char *string2; - int i, match, nocase = 0, reqlength = -1; - size_t length; + int i, match, nocase = 0; + Tcl_Size length, reqlength = -1; if (objc < 3 || objc > 6) { str_cmp_args: @@ -2663,7 +2662,7 @@ StringEqualCmd( goto str_cmp_args; } i++; - if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { + if (TclGetSizeIntFromObj(interp, objv[i], &reqlength) != TCL_OK) { return TCL_ERROR; } } else { @@ -2718,7 +2717,8 @@ StringCmpCmd( * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ - int match, nocase, reqlength, status; + int match, nocase, status; + Tcl_Size reqlength; status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength); if (status != TCL_OK) { @@ -2737,10 +2737,10 @@ TclStringCmpOpts( int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, - int *reqlength) + Tcl_Size *reqlength) { int i; - size_t length; + Tcl_Size length; const char *string; *reqlength = -1; @@ -2762,7 +2762,7 @@ TclStringCmpOpts( goto str_cmp_args; } i++; - if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) { + if (TclGetSizeIntFromObj(interp, objv[i], reqlength) != TCL_OK) { return TCL_ERROR; } } else { @@ -2880,7 +2880,7 @@ StringLowerCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2; + Tcl_Size length1, length2; const char *string1; char *string2; @@ -2898,7 +2898,7 @@ StringLowerCmd( Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - size_t first, last; + Tcl_Size first, last; const char *start, *end; Tcl_Obj *resultPtr; @@ -2906,7 +2906,7 @@ StringLowerCmd( if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = 0; } last = first; @@ -2916,10 +2916,10 @@ StringLowerCmd( return TCL_ERROR; } - if (last + 1 >= length1 + 1) { + if (last >= length1) { last = length1; } - if (last + 1 < first + 1) { + if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } @@ -2933,7 +2933,7 @@ StringLowerCmd( length2 = Tcl_UtfToLower(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); - Tcl_AppendToObj(resultPtr, end, TCL_INDEX_NONE); + Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } @@ -2965,7 +2965,7 @@ StringUpperCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2; + Tcl_Size length1, length2; const char *string1; char *string2; @@ -2983,7 +2983,7 @@ StringUpperCmd( Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - size_t first, last; + Tcl_Size first, last; const char *start, *end; Tcl_Obj *resultPtr; @@ -2991,8 +2991,8 @@ StringUpperCmd( if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; + if (first < 0) { + first = 0; } last = first; @@ -3001,10 +3001,10 @@ StringUpperCmd( return TCL_ERROR; } - if (last + 1 >= length1 + 1) { + if (last >= length1) { last = length1; } - if (last + 1 < first + 1) { + if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } @@ -3018,7 +3018,7 @@ StringUpperCmd( length2 = Tcl_UtfToUpper(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); - Tcl_AppendToObj(resultPtr, end, TCL_INDEX_NONE); + Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } @@ -3050,7 +3050,7 @@ StringTitleCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t length1, length2; + Tcl_Size length1, length2; const char *string1; char *string2; @@ -3068,7 +3068,7 @@ StringTitleCmd( Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { - size_t first, last; + Tcl_Size first, last; const char *start, *end; Tcl_Obj *resultPtr; @@ -3076,8 +3076,8 @@ StringTitleCmd( if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } - if (first == TCL_INDEX_NONE) { - first = TCL_INDEX_START; + if (first < 0) { + first = 0; } last = first; @@ -3086,10 +3086,10 @@ StringTitleCmd( return TCL_ERROR; } - if (last + 1 >= length1 + 1) { + if (last >= length1) { last = length1; } - if (last + 1 < first + 1) { + if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } @@ -3103,7 +3103,7 @@ StringTitleCmd( length2 = Tcl_UtfToTitle(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); - Tcl_AppendToObj(resultPtr, end, TCL_INDEX_NONE); + Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } @@ -3136,7 +3136,7 @@ StringTrimCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; - size_t triml, trimr, length1, length2; + Tcl_Size triml, trimr, length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); @@ -3184,7 +3184,7 @@ StringTrimLCmd( { const char *string1, *string2; int trim; - size_t length1, length2; + Tcl_Size length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); @@ -3231,7 +3231,7 @@ StringTrimRCmd( { const char *string1, *string2; int trim; - size_t length1, length2; + Tcl_Size length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); @@ -3328,7 +3328,7 @@ TclInitStringCmd( int TclSubstOptions( Tcl_Interp *interp, - size_t numOpts1, + Tcl_Size numOpts, Tcl_Obj *const opts[], int *flagPtr) { @@ -3339,7 +3339,6 @@ TclSubstOptions( SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS }; int i, flags = TCL_SUBST_ALL; - int numOpts = numOpts1; for (i = 0; i < numOpts; i++) { int optionIndex; @@ -3432,7 +3431,7 @@ TclNRSwitchObjCmd( { int i, mode, foundmode, splitObjs, numMatchesSaved; int noCase; - size_t patternLength, j; + Tcl_Size patternLength, j; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; @@ -3580,7 +3579,7 @@ TclNRSwitchObjCmd( splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; - size_t listc; + Tcl_Size listc; blist = objv[0]; if (TclListObjLengthM(interp, objv[0], &listc) != TCL_OK) { @@ -3612,7 +3611,7 @@ TclNRSwitchObjCmd( if (objc % 2) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra switch pattern with no body", TCL_INDEX_NONE)); + "extra switch pattern with no body", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", NULL); @@ -3630,7 +3629,7 @@ TclNRSwitchObjCmd( Tcl_AppendToObj(Tcl_GetObjResult(interp), ", this may be due to a comment incorrectly" " placed outside of a switch body - see the" - " \"switch\" documentation", TCL_INDEX_NONE); + " \"switch\" documentation", -1); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", "COMMENT?", NULL); break; @@ -3748,7 +3747,7 @@ TclNRSwitchObjCmd( if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; - if (info.matches[j].end + 1 > 1) { + if (info.matches[j].end > 0) { TclNewIndexObj(rangeObjAry[0], info.matches[j].start); TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { @@ -3767,7 +3766,7 @@ TclNRSwitchObjCmd( if (matchVarObj != NULL) { Tcl_Obj *substringObj; - if (info.matches[j].end + 1 > 1) { + if (info.matches[j].end > 0) { substringObj = Tcl_GetRange(stringObj, info.matches[j].start, info.matches[j].end-1); } else { @@ -3872,7 +3871,7 @@ TclNRSwitchObjCmd( } for (j = i + 1; ; j += 2) { - if (j >= (size_t)objc) { + if (j >= objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... @@ -3906,7 +3905,7 @@ SwitchPostProc( CmdFrame *ctxPtr = (CmdFrame *)data[1]; int pc = PTR2INT(data[2]); const char *pattern = (const char *)data[3]; - size_t patternLength = strlen(pattern); + Tcl_Size patternLength = strlen(pattern); /* * Clean up TIP 280 context information @@ -3928,12 +3927,12 @@ SwitchPostProc( */ if (result == TCL_ERROR) { - unsigned limit = 50; + int limit = 50; int overflow = (patternLength > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", - (overflow ? limit : (unsigned)patternLength), pattern, + (int) (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } TclStackFree(interp, ctxPtr); @@ -3965,7 +3964,7 @@ Tcl_ThrowObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options; - size_t len; + Tcl_Size len; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "type message"); @@ -3980,7 +3979,7 @@ Tcl_ThrowObjCmd( return TCL_ERROR; } else if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "type must be non-empty list", TCL_INDEX_NONE)); + "type must be non-empty list", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION", NULL); return TCL_ERROR; @@ -4682,7 +4681,7 @@ TclNRTryObjCmd( { Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL; int i, bodyShared, haveHandlers, code; - size_t dummy; + Tcl_Size dummy; static const char *const handlerNames[] = { "finally", "on", "trap", NULL }; @@ -4718,7 +4717,7 @@ TclNRTryObjCmd( case TryFinally: /* finally script */ if (i < objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "finally clause must be last", TCL_INDEX_NONE)); + "finally clause must be last", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "NONTERMINAL", NULL); @@ -4726,7 +4725,7 @@ TclNRTryObjCmd( } else if (i == objc-1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args to finally clause: must be" - " \"... finally script\"", TCL_INDEX_NONE)); + " \"... finally script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "ARGUMENT", NULL); @@ -4739,7 +4738,7 @@ TclNRTryObjCmd( if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args to on clause: must be \"... on code" - " variableList script\"", TCL_INDEX_NONE)); + " variableList script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON", "ARGUMENT", NULL); @@ -4800,7 +4799,7 @@ TclNRTryObjCmd( } if (bodyShared) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "last non-finally clause must not have a body of \"-\"", TCL_INDEX_NONE)); + "last non-finally clause must not have a body of \"-\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH", NULL); @@ -4880,7 +4879,7 @@ TryPostBody( { Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv; int code, objc; - size_t i, numHandlers = 0; + Tcl_Size i, numHandlers = 0; handlersObj = (Tcl_Obj *)data[0]; finallyObj = (Tcl_Obj *)data[1]; @@ -4930,7 +4929,7 @@ TryPostBody( TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; inumLists = 1; - infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(size_t)); + infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -635,7 +635,7 @@ TclCompileCatchCmd( * catch range so that errors in the substitution are not caught. * [Bug 219184] * The reason for duplicating the script is that EVAL_STK would otherwise - * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. + * begin by underflowing the stack below the mark set by BEGIN_CATCH4. */ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); @@ -891,7 +891,7 @@ TclCompileConcatCmd( if (listObj != NULL) { Tcl_Obj **objs; const char *bytes; - size_t len, slen; + Tcl_Size len, slen; TclListObjGetElementsM(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); @@ -983,7 +983,7 @@ TclCompileContinueCmd( * * TclCompileDict*Cmd -- * - * Functions called to compile "dict" sucommands. + * Functions called to compile "dict" subcommands. * * Results: * All return TCL_OK for a successful compile, and TCL_ERROR to defer @@ -1078,7 +1078,7 @@ TclCompileDictIncrCmd( if (parsePtr->numWords == 4) { const char *word; - size_t numBytes; + Tcl_Size numBytes; int code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; @@ -1293,7 +1293,7 @@ TclCompileDictCreateCmd( Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; int i; - size_t len; + Tcl_Size len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; @@ -1528,7 +1528,7 @@ CompileDictEachCmd( Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; - size_t numVars; + Tcl_Size numVars; int endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ @@ -1690,7 +1690,7 @@ CompileDictEachCmd( /* * Error handler "finally" clause, which force-terminates the iteration - * and rethrows the error. + * and re-throws the error. */ TclAdjustStackDepth(-1, envPtr); @@ -1862,7 +1862,7 @@ TclCompileDictUpdateCmd( /* * Termination code for non-ok returns: stash the result and return * options in the stack, bring up the key list, finish the update code, - * and finally return with the catched return data + * and finally return with the caught return data */ ExceptionRangeTarget(envPtr, range, catchOffset); @@ -1908,7 +1908,7 @@ TclCompileDictAppendCmd( /* * There must be at least two argument after the command. And we impose an - * (arbirary) safe limit; anyone exceeding it should stop worrying about + * (arbitrary) safe limit; anyone exceeding it should stop worrying about * speed quite so much. ;-) */ @@ -2296,11 +2296,11 @@ PrintDictUpdateInfo( TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; - size_t i; + Tcl_Size i; for (i=0 ; ilength ; i++) { if (i) { - Tcl_AppendToObj(appendObj, ", ", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", duiPtr->varIndices[i]); } @@ -2314,7 +2314,7 @@ DisassembleDictUpdateInfo( TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; - size_t i; + Tcl_Size i; Tcl_Obj *variables; TclNewObj(variables); @@ -2322,7 +2322,7 @@ DisassembleDictUpdateInfo( Tcl_ListObjAppendElement(NULL, variables, Tcl_NewWideIntObj(duiPtr->varIndices[i])); } - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1), variables); } @@ -2690,7 +2690,7 @@ CompileEachloopCmd( Tcl_Token *tokenPtr, *bodyTokenPtr; int jumpBackOffset, infoIndex, range; int numWords, numLists, i, code = TCL_OK; - size_t j; + Tcl_Size j; Tcl_Obj *varListObj = NULL; /* @@ -2742,7 +2742,7 @@ CompileEachloopCmd( i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { ForeachVarList *varListPtr; - size_t numVars; + Tcl_Size numVars; if (i%2 != 1) { continue; @@ -2762,7 +2762,7 @@ CompileEachloopCmd( } varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) - + numVars * sizeof(size_t)); + + numVars * sizeof(varListPtr->varIndexes[0])); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; infoPtr->numLists++; @@ -2771,7 +2771,7 @@ CompileEachloopCmd( Tcl_Obj *varNameObj; const char *bytes; int varIndex; - size_t length; + Tcl_Size length; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); @@ -2980,13 +2980,13 @@ PrintForeachInfo( { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - size_t i, j; + Tcl_Size i, j; - Tcl_AppendToObj(appendObj, "data=[", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "data=[", -1); for (i=0 ; inumLists ; i++) { if (i) { - Tcl_AppendToObj(appendObj, ", ", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", (infoPtr->firstValueTemp + i)); @@ -2995,19 +2995,19 @@ PrintForeachInfo( infoPtr->loopCtTemp); for (i=0 ; inumLists ; i++) { if (i) { - Tcl_AppendToObj(appendObj, ",", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%" TCL_Z_MODIFIER "u\t[", (infoPtr->firstValueTemp + i)); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { if (j) { - Tcl_AppendToObj(appendObj, ", ", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", varsPtr->varIndexes[j]); } - Tcl_AppendToObj(appendObj, "]", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "]", -1); } } @@ -3020,24 +3020,24 @@ PrintNewForeachInfo( { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - size_t i, j; + Tcl_Size i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+" TCL_Z_MODIFIER "d, vars=", infoPtr->loopCtTemp); for (i=0 ; inumLists ; i++) { if (i) { - Tcl_AppendToObj(appendObj, ",", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ",", -1); } - Tcl_AppendToObj(appendObj, "[", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "[", -1); varsPtr = infoPtr->varLists[i]; for (j=0 ; jnumVars ; j++) { if (j) { - Tcl_AppendToObj(appendObj, ",", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", varsPtr->varIndexes[j]); } - Tcl_AppendToObj(appendObj, "]", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "]", -1); } } @@ -3050,7 +3050,7 @@ DisassembleForeachInfo( { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - size_t i, j; + Tcl_Size i, j; Tcl_Obj *objPtr, *innerPtr; /* @@ -3062,13 +3062,13 @@ DisassembleForeachInfo( Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(infoPtr->firstValueTemp + i)); } - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", TCL_INDEX_NONE), objPtr); + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr); /* * Loop counter. */ - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1), Tcl_NewWideIntObj(infoPtr->loopCtTemp)); /* @@ -3085,7 +3085,7 @@ DisassembleForeachInfo( } Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); } - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", TCL_INDEX_NONE), objPtr); + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } static void @@ -3097,14 +3097,14 @@ DisassembleNewForeachInfo( { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; - size_t i, j; + Tcl_Size i, j; Tcl_Obj *objPtr, *innerPtr; /* * Jump offset. */ - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1), Tcl_NewWideIntObj(infoPtr->loopCtTemp)); /* @@ -3121,7 +3121,7 @@ DisassembleNewForeachInfo( } Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); } - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", TCL_INDEX_NONE), objPtr); + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } /* @@ -3156,7 +3156,7 @@ TclCompileFormatCmd( Tcl_Obj **objv, *formatObj, *tmpObj; const char *bytes, *start; int i, j; - size_t len; + Tcl_Size len; /* * Don't handle any guaranteed-error cases. diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index c86d3691a19b..f35cd508925e 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -416,7 +416,7 @@ TclCompileIfCmd( if (TclFixupForwardJumpToHere(envPtr, jumpEndFixupArray.fixup + jumpIndex, 127)) { /* - * Adjust the immediately preceeding "ifFalse" jump. We moved it's + * Adjust the immediately preceding "ifFalse" jump. We moved it's * target (just after this jump) down three bytes. */ @@ -619,8 +619,8 @@ TclCompileInfoCommandsCmd( Tcl_DecrRefCount(objPtr); /* - * Confirmed as a literal that will not frighten the horses. Compile. Note - * that the result needs to be list-ified. + * Confirmed as a literal that will not frighten the horses. Compile. + * The result must be made into a list. */ /* TODO: Just push the known value */ @@ -2113,7 +2113,7 @@ TclCompileRegsubCmd( Tcl_DString pattern; const char *bytes; int exact, quantified, result = TCL_ERROR; - size_t len; + Tcl_Size len; if ((int)parsePtr->numWords < 5 || (int)parsePtr->numWords > 6) { return TCL_ERROR; @@ -2268,7 +2268,7 @@ TclCompileReturnCmd( * An even number of words means an explicit result argument is present. */ int level, code, objc, status = TCL_OK; - size_t size; + Tcl_Size size; int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; @@ -2478,7 +2478,7 @@ TclCompileSyntaxError( CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); - size_t numBytes; + Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); @@ -2705,7 +2705,7 @@ IndexTailVarIfKnown( Tcl_Obj *tailPtr; const char *tailName, *p; int n = varTokenPtr->numComponents; - size_t len; + Tcl_Size len; Tcl_Token *lastTokenPtr; int full, localIndex; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index b86aa430bf73..05d50e9c9809 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -252,7 +252,7 @@ TclCompileStringCatCmd( } else { Tcl_DecrRefCount(obj); if (folded) { - size_t len; + Tcl_Size len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -270,7 +270,7 @@ TclCompileStringCatCmd( wordTokenPtr = TokenAfter(wordTokenPtr); } if (folded) { - size_t len; + Tcl_Size len; const char *bytes = Tcl_GetStringFromObj(folded, &len); PushLiteral(envPtr, bytes, len); @@ -897,7 +897,7 @@ TclCompileStringLenCmd( char buf[TCL_INTEGER_SPACE]; size_t len = Tcl_GetCharLength(objPtr); - len = sprintf(buf, "%" TCL_Z_MODIFIER "u", len); + len = snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", len); PushLiteral(envPtr, buf, len); } else { SetLineInformation(1); @@ -921,7 +921,7 @@ TclCompileStringMapCmd( Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; const char *bytes; - size_t len, slen; + Tcl_Size len, slen; /* * We only handle the case: @@ -1517,14 +1517,14 @@ void TclSubstCompile( Tcl_Interp *interp, const char *bytes, - size_t numBytes, + Tcl_Size numBytes, int flags, - size_t line, + Tcl_Size line, CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; int breakOffset = 0, count = 0; - size_t bline = line; + Tcl_Size bline = line; Tcl_Parse parse; Tcl_InterpState state = NULL; @@ -1549,7 +1549,7 @@ TclSubstCompile( for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { - size_t length; + Tcl_Size length; int literal, catchRange, breakJump; char buf[4] = ""; JumpFixup startFixup, okFixup, returnFixup, breakFixup; @@ -1581,7 +1581,7 @@ TclSubstCompile( */ if (tokenPtr->numComponents > 1) { - size_t i; + Tcl_Size i; int foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { @@ -1945,8 +1945,8 @@ TclCompileSwitchCmd( if (numWords == 1) { const char *bytes; - size_t maxLen, numBytes; - size_t bline; /* TIP #280: line of the pattern/action list, + Tcl_Size maxLen, numBytes; + Tcl_Size bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after * the value we switch on. */ @@ -2382,7 +2382,7 @@ IssueSwitchJumpTable( * Compile the switch by using a jump table, which is basically a * hashtable that maps from literal values to match against to the offset * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump - * table itself is independent of any invokation of the bytecode, and as + * table itself is independent of any invocation of the bytecode, and as * such is stored in an auxData block. * * Start by allocating the jump table itself, plus some workspace. @@ -2604,9 +2604,9 @@ PrintJumptableInfo( offset = PTR2INT(Tcl_GetHashValue(hPtr)); if (i++) { - Tcl_AppendToObj(appendObj, ", ", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, ", ", -1); if (i%4==0) { - Tcl_AppendToObj(appendObj, "\n\t\t", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\n\t\t", -1); } } Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %" TCL_Z_MODIFIER "u", @@ -2633,10 +2633,10 @@ DisassembleJumptableInfo( for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); - Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1), Tcl_NewWideIntObj(offset)); } - Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", TCL_INDEX_NONE), mapping); + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping); } /* @@ -2669,7 +2669,7 @@ TclCompileTailcallCmd( Tcl_Token *tokenPtr = parsePtr->tokenPtr; int i; - if (parsePtr->numWords < 2 || parsePtr->numWords > 256 + if (parsePtr->numWords < 2 || parsePtr->numWords >= 256 || envPtr->procPtr == NULL) { return TCL_ERROR; } @@ -2716,7 +2716,7 @@ TclCompileThrowCmd( Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; int codeKnown, codeIsList, codeIsValid; - size_t len; + Tcl_Size len; if (numWords != 3) { return TCL_ERROR; @@ -2857,7 +2857,7 @@ TclCompileTryCmd( for (i=0 ; itype != TCL_TOKEN_SIMPLE_WORD) { goto failedToCompile; @@ -2922,7 +2922,7 @@ TclCompileTryCmd( goto failedToCompile; } if (objc > 0) { - size_t len; + Tcl_Size len; const char *varname = Tcl_GetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); @@ -2934,7 +2934,7 @@ TclCompileTryCmd( resultVarIndices[i] = -1; } if (objc == 2) { - size_t len; + Tcl_Size len; const char *varname = Tcl_GetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); @@ -3056,7 +3056,7 @@ IssueTryClausesInstructions( DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; - size_t slen, len; + Tcl_Size slen, len; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; int *noError; char buf[TCL_INTEGER_SPACE]; @@ -3124,7 +3124,7 @@ IssueTryClausesInstructions( for (i=0 ; itokenPtr; - size_t words; + Tcl_Size words; /* TODO: Consider support for compiling expanded args. */ for (words=1 ; wordsnumWords ; words++) { @@ -4081,13 +4081,13 @@ CompileAssociativeBinaryOpCmd( CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { - PushLiteral(envPtr, identity, TCL_INDEX_NONE); + PushLiteral(envPtr, identity, -1); words++; } if (words > 3) { /* * Reverse order of arguments to get precise agreement with [expr] in - * calcuations, including roundoff errors. + * calculations, including roundoff errors. */ OP4( REVERSE, words-1); @@ -4176,7 +4176,7 @@ CompileComparisonOpCmd( return TCL_ERROR; } else { int tmpIndex = AnonymousLocal(envPtr); - size_t words; + Tcl_Size words; tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); @@ -4312,7 +4312,7 @@ TclCompilePowOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - size_t words; + Tcl_Size words; /* * This one has its own implementation because the ** operator is the only @@ -4513,7 +4513,7 @@ TclCompileMinusOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - size_t words; + Tcl_Size words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { @@ -4538,7 +4538,7 @@ TclCompileMinusOpCmd( /* * Reverse order of arguments to get precise agreement with [expr] in - * calcuations, including roundoff errors. + * calculations, including roundoff errors. */ TclEmitInstInt4(INST_REVERSE, words-1, envPtr); @@ -4558,7 +4558,7 @@ TclCompileDivOpCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; - size_t words; + Tcl_Size words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { @@ -4582,7 +4582,7 @@ TclCompileDivOpCmd( /* * Reverse order of arguments to get precise agreement with [expr] in - * calcuations, including roundoff errors. + * calculations, including roundoff errors. */ TclEmitInstInt4(INST_REVERSE, words-1, envPtr); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index c503304e027a..a8d60dd4b9f5 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -96,7 +96,7 @@ enum OperandTypes { * * The lexeme field is filled in with the lexeme of the operator that is * returned by the ParseLexeme() routine. Only lexemes for unary and binary - * operators get stored in an OpNode. Other lexmes get different treatement. + * operators get stored in an OpNode. Other lexmes get different treatment. * * The precedence field provides a place to store the precedence of the * operator, so it need not be looked up again and again. @@ -157,7 +157,7 @@ enum Marks { * BINARY_PLUS according to context. */ #define MINUS 2 /* Ambiguous. Resolves to UNARY_MINUS or * BINARY_MINUS according to context. */ -#define BAREWORD 3 /* Ambigous. Resolves to BOOLEAN or to +#define BAREWORD 3 /* Ambiguous. Resolves to BOOLEAN or to * FUNCTION or a parse error according to * context and value. */ #define INCOMPLETE 4 /* A parse error. Used only when the single @@ -511,16 +511,16 @@ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize); -static void ConvertTreeToTokens(const char *start, size_t numBytes, +static void ConvertTreeToTokens(const char *start, Tcl_Size numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, - size_t numBytes, OpNode **opTreePtr, + Tcl_Size numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, int parseOnly); -static size_t ParseLexeme(const char *start, size_t numBytes, +static Tcl_Size ParseLexeme(const char *start, Tcl_Size numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); /* @@ -558,7 +558,7 @@ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - size_t numBytes, /* Number of bytes in string. */ + Tcl_Size numBytes, /* Number of bytes in string. */ OpNode **opTreePtr, /* Points to space where a pointer to the * allocated OpNode tree should go. */ Tcl_Obj *litList, /* List to append literals to. */ @@ -576,12 +576,12 @@ ParseExpr( * we build the parse tree. */ unsigned int nodesAvailable = 64; /* Initial size of the storage array. This * value establishes a minimum tree memory - * cost of only about 1 kibyte, and is large + * cost of only about 1 kilobyte, and is large * enough for most expressions to parse with * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ - size_t scanned = 0; /* Capture number of byte scanned by parsing + Tcl_Size scanned = 0; /* Capture number of byte scanned by parsing * routines. */ int lastParsed; /* Stores info about what the lexeme parsed * the previous pass through the parsing loop @@ -625,7 +625,7 @@ ParseExpr( * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ - const unsigned limit = 25; /* Portions of the error message are + const int limit = 25; /* Portions of the error message are * constructed out of substrings of the * original expression. In order to keep the * error message readable, we impose this @@ -777,16 +777,16 @@ ParseExpr( Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", - (scanned < limit) ? (int)scanned : (int)limit - 3, start, + (int)((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", - (scanned < limit) ? (int)scanned : (int)limit - 3, + (int) ((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "...", - (scanned < limit) ? (int)scanned : (int)limit - 3, + (int) ((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "..."); Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", - (scanned < limit) ? (int)scanned : (int)limit - 3, + (int) ((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "..."); errCode = "BAREWORD"; if (start[0] == '0') { @@ -798,14 +798,14 @@ ParseExpr( switch (start[1]) { case 'b': Tcl_AppendToObj(post, - " (invalid binary number?)", TCL_INDEX_NONE); + " (invalid binary number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "BINARY"; break; case 'o': Tcl_AppendToObj(post, - " (invalid octal number?)", TCL_INDEX_NONE); + " (invalid octal number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; @@ -813,7 +813,7 @@ ParseExpr( default: if (isdigit(UCHAR(start[1]))) { Tcl_AppendToObj(post, - " (invalid octal number?)", TCL_INDEX_NONE); + " (invalid octal number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; @@ -1462,7 +1462,7 @@ ParseExpr( */ if (post != NULL) { - Tcl_AppendToObj(msg, ";\n", TCL_INDEX_NONE); + Tcl_AppendToObj(msg, ";\n", -1); Tcl_AppendObjToObj(msg, post); Tcl_DecrRefCount(post); } @@ -1512,7 +1512,7 @@ ParseExpr( static void ConvertTreeToTokens( const char *start, - size_t numBytes, + Tcl_Size numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) @@ -1860,7 +1860,7 @@ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ - size_t numBytes, /* Number of bytes in string. If -1, the + Tcl_Size numBytes, /* Number of bytes in string. If -1, the * string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Structure to fill with information about @@ -1876,7 +1876,7 @@ Tcl_ParseExpr( TclNewObj(litList); TclNewObj(funcList); - if (numBytes == TCL_INDEX_NONE) { + if (numBytes < 0) { numBytes = (start ? strlen(start) : 0); } @@ -1912,15 +1912,15 @@ Tcl_ParseExpr( * Returns the number of bytes scanned to produce the lexeme. * * Side effects: - * Code identifying lexeme parsed is writen to *lexemePtr. + * Code identifying lexeme parsed is written to *lexemePtr. * *---------------------------------------------------------------------- */ -static size_t +static Tcl_Size ParseLexeme( const char *start, /* Start of lexeme to parse. */ - size_t numBytes, /* Number of bytes in string. */ + Tcl_Size numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this @@ -1945,7 +1945,7 @@ ParseLexeme( /* * Scan forward over the comment contents. */ - size_t size; + Tcl_Size size; for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) { byte = UCHAR(start[size]); @@ -2147,7 +2147,7 @@ ParseLexeme( */ if (!TclIsBareword(*start) || *start == '_') { - size_t scanned; + Tcl_Size scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUCS4(start, &ch); } else { @@ -2197,7 +2197,7 @@ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ - size_t numBytes, /* Number of bytes in script. */ + Tcl_Size numBytes, /* Number of bytes in script. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int optimize) /* 0 for one-off expressions. */ { @@ -2218,7 +2218,7 @@ TclCompileExpr( * Valid parse; compile the tree. */ - size_t objc; + Tcl_Size objc; Tcl_Obj *const *litObjv; Tcl_Obj **funcObjv; @@ -2348,7 +2348,7 @@ CompileExprTree( case FUNCTION: { Tcl_DString cmdName; const char *p; - size_t length; + Tcl_Size length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); @@ -2507,7 +2507,7 @@ CompileExprTree( Tcl_Obj *literal = *litObjv; if (optimize) { - size_t length; + Tcl_Size length; const char *bytes = Tcl_GetStringFromObj(literal, &length); int idx = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx); @@ -2566,7 +2566,7 @@ CompileExprTree( if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; - size_t numBytes; + Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); diff --git a/generic/tclCompile.c b/generic/tclCompile.c index be308e3a2556..926c492a7771 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -680,9 +680,9 @@ static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, - size_t cmdNumber, size_t numSrcBytes, size_t numCodeBytes); + Tcl_Size cmdNumber, Tcl_Size numSrcBytes, Tcl_Size numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, - size_t cmdNumber, size_t srcOffset, size_t codeOffset); + Tcl_Size cmdNumber, Tcl_Size srcOffset, Tcl_Size codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); @@ -699,9 +699,9 @@ static void StartExpanding(CompileEnv *envPtr); * TIP #280: Helper for building the per-word line information of all compiled * commands. */ -static void EnterCmdWordData(ExtCmdLoc *eclPtr, size_t srcOffset, +static void EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset, Tcl_Token *tokenPtr, const char *cmd, - size_t numWords, size_t line, int *clNext, int **lines, + Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); @@ -776,7 +776,7 @@ TclSetByteCodeFromAny( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - size_t length; + Tcl_Size length; int result = TCL_OK; const char *stringPtr; Proc *procPtr = iPtr->compiledProcPtr; @@ -869,6 +869,18 @@ TclSetByteCodeFromAny( result = hookProc(interp, &compEnv, clientData); } + /* + * After optimization is all done, check that byte code length limits + * are not exceeded. Bug [27b3ce2997]. + */ + if ((compEnv.codeNext - compEnv.codeStart) > INT_MAX) { + /* + * Cannot just return TCL_ERROR as callers ignore return value. + * TODO - May be use TclCompileSyntaxError here? + */ + Tcl_Panic("Maximum byte code length %d exceeded.", INT_MAX); + } + /* * Change the object into a ByteCode object. Ownership of the literal * objects and aux data items passes to the ByteCode object. @@ -1328,7 +1340,7 @@ CompileSubstObj( } if (codePtr == NULL) { CompileEnv compEnv; - size_t numBytes; + Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ @@ -1391,7 +1403,7 @@ static void ReleaseCmdWordData( ExtCmdLoc *eclPtr) { - size_t i; + Tcl_Size i; if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); @@ -1553,7 +1565,7 @@ TclInitCompileEnv( pc = 1; } - if ((ctxPtr->nline <= (size_t)word) || (ctxPtr->line[word] < 0)) { + if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) { /* * Word is not a literal, relative counting. */ @@ -1647,7 +1659,7 @@ TclFreeCompileEnv( * have transferred to it. */ - size_t i; + Tcl_Size i; LiteralEntry *entryPtr = envPtr->literalArrayPtr; AuxData *auxDataPtr = envPtr->auxDataArrayPtr; @@ -1812,7 +1824,7 @@ CompileCmdLiteral( const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; - size_t length; + Tcl_Size length; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { @@ -2037,7 +2049,7 @@ CompileCommandTokens( assert ((int)parsePtr->numWords > 0); - /* Pre-Compile */ + /* Precompile */ TclNewObj(cmdObj); envPtr->numCommands++; @@ -2136,7 +2148,7 @@ TclCompileScript( * serves as context for finding and compiling * commands. May not be NULL. */ const char *script, /* The source script to compile. */ - size_t numBytes, /* Number of bytes in script. If -1, the + Tcl_Size numBytes, /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ CompileEnv *envPtr) /* Holds resulting instructions. */ @@ -2161,15 +2173,32 @@ TclCompileScript( */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "too many nested compilations (infinite loop?)", TCL_INDEX_NONE)); + "too many nested compilations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); TclCompileSyntaxError(interp, envPtr); return; } + if (numBytes < 0) { + numBytes = strlen(script); + } + /* Each iteration compiles one command from the script. */ - if (numBytes + 1 > 1) { + if (numBytes > 0) { + if (numBytes >= INT_MAX) { + /* + * Note this gets -errorline as 1. Not worth figuring out which line + * crosses the limit to get -errorline for this error case. + */ + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER + "d exceeds max permitted length %d.", + numBytes, (int)INT_MAX-1)); + Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL); + TclCompileSyntaxError(interp, envPtr); + return; + } /* * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so * many nested compilations (body enclosed in body) can cause abnormal @@ -2323,8 +2352,8 @@ TclCompileVarSubst( CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - size_t i, nameBytes = tokenPtr[1].size; - size_t localVar; + Tcl_Size i, nameBytes = tokenPtr[1].size; + Tcl_Size localVar; int localVarName = 1; /* @@ -2352,11 +2381,11 @@ TclCompileVarSubst( * of local variables in a procedure frame. */ - localVar = TCL_INDEX_NONE; + localVar = -1; if (localVarName != -1) { localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr); } - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { PushLiteral(envPtr, name, nameBytes); } @@ -2368,7 +2397,7 @@ TclCompileVarSubst( tokenPtr[1].start + tokenPtr[1].size); if (tokenPtr->numComponents == 1) { - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { TclEmitOpcode(INST_LOAD_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); @@ -2377,7 +2406,7 @@ TclCompileVarSubst( } } else { TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr); - if (localVar == TCL_INDEX_NONE) { + if (localVar < 0) { TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr); @@ -2409,9 +2438,9 @@ TclCompileTokens( int count = count1; /* - * if this is actually a literal, handle continuation lines by + * If this is actually a literal, handle continuation lines by * preallocating a small table to store the locations of any continuation - * lines we find in this literal. The table is extended if needed. + * lines found in this literal. The table is extended if needed. * * Note: In contrast with the analagous code in 'TclSubstTokens()' the * 'adjust' variable seems unneeded here. The code which merges @@ -2776,7 +2805,7 @@ PreventCycle( Tcl_Obj *objPtr, CompileEnv *envPtr) { - size_t i; + Tcl_Size i; for (i = 0; i < envPtr->literalArrayNext; i++) { if (objPtr == TclFetchLiteral(envPtr, i)) { @@ -2791,7 +2820,7 @@ PreventCycle( * can be sure we do not have any lingering cycles hiding in * the internalrep. */ - size_t numBytes; + Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); @@ -2993,19 +3022,19 @@ TclInitByteCodeObj( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclFindCompiledLocal( const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ - size_t nameBytes, /* Number of bytes in the name. */ + Tcl_Size nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { CompiledLocal *localPtr; - size_t localVar = TCL_INDEX_NONE; - size_t i; + Tcl_Size localVar = TCL_INDEX_NONE; + Tcl_Size i; Proc *procPtr; /* @@ -3024,7 +3053,7 @@ TclFindCompiledLocal( LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; - size_t len; + Tcl_Size len; if (!cachePtr || !name) { return TCL_INDEX_NONE; @@ -3043,7 +3072,7 @@ TclFindCompiledLocal( } if (name != NULL) { - size_t localCt = procPtr->numCompiledLocals; + Tcl_Size localCt = procPtr->numCompiledLocals; localPtr = procPtr->firstLocalPtr; for (i = 0; i < localCt; i++) { @@ -3171,14 +3200,14 @@ EnterCmdStartData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ - size_t cmdIndex, /* Index of the command whose start data is + Tcl_Size cmdIndex, /* Index of the command whose start data is * being set. */ - size_t srcOffset, /* Offset of first char of the command. */ - size_t codeOffset) /* Offset of first byte of command code. */ + Tcl_Size srcOffset, /* Offset of first char of the command. */ + Tcl_Size codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; - if (cmdIndex >= envPtr->numCommands) { + if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) { Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); } @@ -3250,14 +3279,14 @@ EnterCmdExtentData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ - size_t cmdIndex, /* Index of the command whose source and code + Tcl_Size cmdIndex, /* Index of the command whose source and code * length data is being set. */ - size_t numSrcBytes, /* Number of command source chars. */ - size_t numCodeBytes) /* Offset of last byte of command code. */ + Tcl_Size numSrcBytes, /* Number of command source chars. */ + Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; - if (cmdIndex >= envPtr->numCommands) { + if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) { Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); } @@ -3296,18 +3325,18 @@ EnterCmdWordData( ExtCmdLoc *eclPtr, /* Points to the map environment structure in * which to enter command location * information. */ - size_t srcOffset, /* Offset of first char of the command. */ + Tcl_Size srcOffset, /* Offset of first char of the command. */ Tcl_Token *tokenPtr, const char *cmd, - size_t numWords, - size_t line, + Tcl_Size numWords, + Tcl_Size line, int *clNext, int **wlines, CompileEnv *envPtr) { ECL *ePtr; const char *last; - size_t wordIdx, wordLine; + Tcl_Size wordIdx, wordLine; int *wwlines, *wordNext; if (eclPtr->nuloc >= eclPtr->nloc) { @@ -3373,7 +3402,7 @@ EnterCmdWordData( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ CompileEnv *envPtr)/* Points to CompileEnv for which to create a @@ -3381,7 +3410,7 @@ TclCreateExceptRange( { ExceptionRange *rangePtr; ExceptionAux *auxPtr; - size_t index = envPtr->exceptArrayNext; + Tcl_Size index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* @@ -3734,7 +3763,7 @@ TclFinalizeLoopExceptionRange( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclCreateAuxData( void *clientData, /* The compilation auxiliary data to store in * the new aux data record. */ @@ -3743,7 +3772,7 @@ TclCreateAuxData( CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { - size_t index; /* Index for the new AuxData structure. */ + Tcl_Size index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ @@ -4416,8 +4445,8 @@ EncodeCmdLocMap( * is to be stored. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; - size_t i, codeDelta, codeLen, srcLen, prevOffset; - size_t numCmds = envPtr->numCommands; + Tcl_Size i, codeDelta, codeLen, srcLen, prevOffset; + Tcl_Size numCmds = envPtr->numCommands; unsigned char *p = startPtr; int srcDelta; @@ -4429,7 +4458,7 @@ EncodeCmdLocMap( prevOffset = 0; for (i = 0; i < numCmds; i++) { codeDelta = mapPtr[i].codeOffset - prevOffset; - if (codeDelta == TCL_INDEX_NONE) { + if (codeDelta < 0) { Tcl_Panic("EncodeCmdLocMap: bad code offset"); } else if (codeDelta <= 127) { TclStoreInt1AtPtr(codeDelta, p); @@ -4450,7 +4479,7 @@ EncodeCmdLocMap( codePtr->codeLengthStart = p; for (i = 0; i < numCmds; i++) { codeLen = mapPtr[i].numCodeBytes; - if (codeLen == TCL_INDEX_NONE) { + if (codeLen < 0) { Tcl_Panic("EncodeCmdLocMap: bad code length"); } else if (codeLen <= 127) { TclStoreInt1AtPtr(codeLen, p); @@ -4490,7 +4519,7 @@ EncodeCmdLocMap( codePtr->srcLengthStart = p; for (i = 0; i < numCmds; i++) { srcLen = mapPtr[i].numSrcBytes; - if (srcLen == TCL_INDEX_NONE) { + if (srcLen < 0) { Tcl_Panic("EncodeCmdLocMap: bad source length"); } else if (srcLen <= 127) { TclStoreInt1AtPtr(srcLen, p); diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 035edac976bb..22abb46bda10 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -444,7 +444,7 @@ typedef struct ByteCode { * active. This structure can be freed when * refCount becomes zero. */ unsigned int flags; /* flags describing state for the codebyte. - * this variable holds ORed values from the + * this variable holds OR'ed values from the * TCL_BYTECODE_ masks defined above */ const char *source; /* The source string from which this ByteCode * was compiled. Note that this pointer is not @@ -1084,7 +1084,7 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr, */ MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp, - Tcl_Parse *parsePtr, size_t depth, Command *cmdPtr, + Tcl_Parse *parsePtr, Tcl_Size depth, Command *cmdPtr, CompileEnv *envPtr); MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr, ExceptionAux *auxPtr); @@ -1092,7 +1092,7 @@ MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t count, CompileEnv *envPtr); MODULE_SCOPE void TclCompileExpr(Tcl_Interp *interp, const char *script, - size_t numBytes, CompileEnv *envPtr, int optimize); + Tcl_Size numBytes, CompileEnv *envPtr, int optimize); MODULE_SCOPE void TclCompileExprWords(Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t numWords, CompileEnv *envPtr); @@ -1100,7 +1100,7 @@ MODULE_SCOPE void TclCompileInvocation(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords, CompileEnv *envPtr); MODULE_SCOPE void TclCompileScript(Tcl_Interp *interp, - const char *script, size_t numBytes, + const char *script, Tcl_Size numBytes, CompileEnv *envPtr); MODULE_SCOPE void TclCompileSyntaxError(Tcl_Interp *interp, CompileEnv *envPtr); @@ -1109,13 +1109,13 @@ MODULE_SCOPE void TclCompileTokens(Tcl_Interp *interp, CompileEnv *envPtr); MODULE_SCOPE void TclCompileVarSubst(Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr); -MODULE_SCOPE size_t TclCreateAuxData(void *clientData, +MODULE_SCOPE Tcl_Size TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); -MODULE_SCOPE size_t TclCreateExceptRange(ExceptionRangeType type, +MODULE_SCOPE Tcl_Size TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, - size_t length, TCL_HASH_TYPE hash, int *newPtr, + Tcl_Size length, size_t hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); @@ -1129,8 +1129,8 @@ MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); MODULE_SCOPE int TclNRExecuteByteCode(Tcl_Interp *interp, ByteCode *codePtr); -MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, TCL_HASH_TYPE index); -MODULE_SCOPE size_t TclFindCompiledLocal(const char *name, size_t nameChars, +MODULE_SCOPE Tcl_Obj * TclFetchLiteral(CompileEnv *envPtr, Tcl_Size index); +MODULE_SCOPE Tcl_Size TclFindCompiledLocal(const char *name, Tcl_Size nameChars, int create, CompileEnv *envPtr); MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr, JumpFixup *jumpFixupPtr, int jumpDist, @@ -1171,9 +1171,9 @@ MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, const unsigned char *pc); MODULE_SCOPE void TclPrintObject(FILE *outFile, - Tcl_Obj *objPtr, size_t maxChars); + Tcl_Obj *objPtr, Tcl_Size maxChars); MODULE_SCOPE void TclPrintSource(FILE *outFile, - const char *string, size_t maxChars); + const char *string, Tcl_Size maxChars); MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, @@ -1195,13 +1195,13 @@ MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr, Tcl_Obj *valuePtr); MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, - size_t length, const unsigned char *pc, + Tcl_Size length, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(void *clientData, - Tcl_Interp *interp, size_t objc, + Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int isLambda); #endif /* TCL_MAJOR_VERSION > 8 */ @@ -1817,7 +1817,7 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi); FILE *tclDTraceDebugLog = NULL; \ void TclDTraceOpenDebugLog(void) { \ char n[35]; \ - sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ + snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ (size_t) getpid()); \ tclDTraceDebugLog = fopen(n, "a"); \ } diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 17490bdece5a..8f58ca8cf425 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -85,7 +85,7 @@ Tcl_RegisterConfig( } else { cdPtr->encoding = NULL; } - cdPtr->pkg = Tcl_NewStringObj(pkgName, TCL_INDEX_NONE); + cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of @@ -127,7 +127,7 @@ Tcl_RegisterConfig( */ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { - Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, TCL_INDEX_NONE), + Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value))); } @@ -144,7 +144,7 @@ Tcl_RegisterConfig( Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "::"); - Tcl_DStringAppend(&cmdName, pkgName, TCL_INDEX_NONE); + Tcl_DStringAppend(&cmdName, pkgName, -1); /* * The incomplete command name is the name of the namespace to place it @@ -181,7 +181,7 @@ Tcl_RegisterConfig( * configuration information embedded into a library. * * Results: - * A standard tcl result. + * A standard Tcl result. * * Side effects: * See the manual for what this command does. @@ -199,7 +199,7 @@ QueryConfigObjCmd( QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; - size_t m, n = 0; + Tcl_Size m, n = 0; static const char *const subcmdStrings[] = { "get", "list", NULL }; @@ -227,7 +227,7 @@ QueryConfigObjCmd( * present. */ - Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE", TclGetString(pkgName), NULL); return TCL_ERROR; @@ -242,7 +242,7 @@ QueryConfigObjCmd( if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -279,7 +279,7 @@ QueryConfigObjCmd( if (!listPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create list", TCL_INDEX_NONE)); + "insufficient memory to create list", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } diff --git a/generic/tclDate.c b/generic/tclDate.c index fa6e60dbe9d3..52bdf4cfa752 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -2425,7 +2425,7 @@ static const TABLE TimezoneTable[] = { { "ist", tZONE, -HOUR(11/2) }, /* Indian Standard */ { "zp6", tZONE, -HOUR( 6) }, /* USSR Zone 5 */ #if 0 - /* For completeness. NST is also Newfoundland Stanard, nad SST is + /* For completeness. NST is also Newfoundland Standard, and SST is * also Swedish Summer. */ { "nst", tZONE, -HOUR(13/2) }, /* North Sumatra */ { "sst", tZONE, -HOUR( 7) }, /* South Sumatra, USSR Zone 6 */ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index ec9a49a5bc5d..feb7a64b3cff 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -136,7 +136,7 @@ EXTERN int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 33 */ EXTERN unsigned char * TclGetByteArrayFromObj(Tcl_Obj *objPtr, - int *numBytesPtr); + void *numBytesPtr); /* 34 */ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr); @@ -156,7 +156,7 @@ EXTERN int Tcl_GetLongFromObj(Tcl_Interp *interp, /* 40 */ EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName); /* 41 */ -EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr); +EXTERN char * TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr); /* 42 */ EXTERN void Tcl_InvalidateStringRep(Tcl_Obj *objPtr); /* 43 */ @@ -167,7 +167,7 @@ EXTERN int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 45 */ EXTERN int TclListObjGetElements(Tcl_Interp *interp, - Tcl_Obj *listPtr, int *objcPtr, + Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 46 */ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, @@ -175,7 +175,7 @@ EXTERN int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj **objPtrPtr); /* 47 */ EXTERN int TclListObjLength(Tcl_Interp *interp, - Tcl_Obj *listPtr, int *lengthPtr); + Tcl_Obj *listPtr, void *lengthPtr); /* 48 */ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, @@ -665,9 +665,9 @@ EXTERN const char * Tcl_SignalMsg(int sig); EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ EXTERN int TclSplitList(Tcl_Interp *interp, const char *listStr, - int *argcPtr, const char ***argvPtr); + void *argcPtr, const char ***argvPtr); /* 243 */ -EXTERN void TclSplitPath(const char *path, int *argcPtr, +EXTERN void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr); /* Slot 244 is reserved */ /* Slot 245 is reserved */ @@ -1137,7 +1137,8 @@ EXTERN int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, /* 433 */ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); /* 434 */ -EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); +EXTERN Tcl_UniChar * TclGetUnicodeFromObj(Tcl_Obj *objPtr, + void *lengthPtr); /* Slot 435 is reserved */ /* Slot 436 is reserved */ /* 437 */ @@ -1209,7 +1210,7 @@ EXTERN int Tcl_FSConvertToPathType(Tcl_Interp *interp, /* 460 */ EXTERN Tcl_Obj * Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements); /* 461 */ -EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr); +EXTERN Tcl_Obj * TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr); /* 462 */ EXTERN int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); @@ -1306,7 +1307,7 @@ EXTERN int Tcl_DictObjRemove(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 497 */ EXTERN int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - int *sizePtr); + void *sizePtr); /* 498 */ EXTERN int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, @@ -1612,7 +1613,7 @@ EXTERN int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 604 */ EXTERN int TclParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, int *objcPtr, + const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 605 */ EXTERN int Tcl_GetErrorLine(Tcl_Interp *interp); @@ -1744,19 +1745,19 @@ EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, int *numBytesPtr); + Tcl_Obj *objPtr, void *numBytesPtr); /* 650 */ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, size_t *numBytesPtr); + Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 651 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, - size_t *lengthPtr); + Tcl_Size *lengthPtr); /* 652 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, - size_t *lengthPtr); + Tcl_Size *lengthPtr); /* 653 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, - size_t *numBytesPtr); + Tcl_Size *numBytesPtr); /* 654 */ EXTERN int Tcl_UtfCharComplete(const char *src, Tcl_Size length); /* 655 */ @@ -1782,27 +1783,27 @@ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); /* 661 */ EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, - Tcl_Obj *listPtr, size_t *objcPtr, + Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 662 */ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, - Tcl_Obj *listPtr, size_t *lengthPtr); + Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 663 */ EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t *sizePtr); + Tcl_Size *sizePtr); /* 664 */ EXTERN int Tcl_SplitList(Tcl_Interp *interp, - const char *listStr, size_t *argcPtr, + const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 665 */ -EXTERN void Tcl_SplitPath(const char *path, size_t *argcPtr, +EXTERN void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 666 */ -EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr); +EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 667 */ EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, - size_t *objcPtr, Tcl_Obj *const *objv, + Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 668 */ EXTERN Tcl_Size Tcl_UniCharLen(const int *uniStr); @@ -1842,14 +1843,14 @@ EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, /* 679 */ EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, - size_t objc, Tcl_Obj *const objv[]); + ptrdiff_t objc, Tcl_Obj *const objv[]); /* 680 */ EXTERN int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 681 */ EXTERN int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, - size_t numBytes, void **clientDataPtr, + Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, @@ -1861,8 +1862,11 @@ EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 685 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); -/* Slot 686 is reserved */ -/* 687 */ +/* 686 */ +EXTERN int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, + Tcl_Obj *objPtr, Tcl_Size *sizePtr); +/* Slot 687 is reserved */ +/* 688 */ EXTERN void TclUnusedStubEntry(void); typedef struct { @@ -1908,7 +1912,7 @@ typedef struct TclStubs { void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */ int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *intPtr); /* 31 */ int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */ - unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */ + unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, void *numBytesPtr); /* 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 */ void (*reserved36)(void); @@ -1916,13 +1920,13 @@ typedef struct TclStubs { int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */ - char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */ + char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 41 */ void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */ int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */ int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */ - int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ + int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 45 */ int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */ - int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */ + int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *lengthPtr); /* 47 */ int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */ void (*reserved49)(void); Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */ @@ -2117,8 +2121,8 @@ typedef struct TclStubs { const char * (*tcl_SignalId) (int sig); /* 239 */ const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ - void (*tclSplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ + int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr); /* 242 */ + void (*tclSplitPath) (const char *path, void *argcPtr, const char ***argvPtr); /* 243 */ void (*reserved244)(void); void (*reserved245)(void); void (*reserved246)(void); @@ -2309,7 +2313,7 @@ typedef struct TclStubs { void * (*tcl_AttemptDbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */ int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */ Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */ - Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */ + Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 434 */ void (*reserved435)(void); void (*reserved436)(void); Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */ @@ -2336,7 +2340,7 @@ typedef struct TclStubs { int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */ int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */ Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, Tcl_Size elements); /* 460 */ - Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */ + Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, void *lenPtr); /* 461 */ int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */ Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */ Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 464 */ @@ -2372,7 +2376,7 @@ typedef struct TclStubs { int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */ int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */ int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */ - int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */ + int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr); /* 497 */ int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */ void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */ void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */ @@ -2479,7 +2483,7 @@ typedef struct TclStubs { unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */ int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */ int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */ - int (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ + int (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */ int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */ void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */ void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */ @@ -2524,11 +2528,11 @@ typedef struct TclStubs { Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ - unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */ - unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *numBytesPtr); /* 650 */ - char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */ - Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */ - unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *numBytesPtr); /* 653 */ + unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *numBytesPtr); /* 649 */ + unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 650 */ + char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 651 */ + Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 652 */ + unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 653 */ int (*tcl_UtfCharComplete) (const char *src, Tcl_Size length); /* 654 */ const char * (*tcl_UtfNext) (const char *src); /* 655 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */ @@ -2536,13 +2540,13 @@ typedef struct TclStubs { int (*tcl_ExternalToUtfDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 658 */ int (*tcl_UtfToExternalDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 659 */ int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */ - int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *objcPtr, Tcl_Obj ***objvPtr); /* 661 */ - int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, size_t *lengthPtr); /* 662 */ - int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, size_t *sizePtr); /* 663 */ - int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, size_t *argcPtr, const char ***argvPtr); /* 664 */ - void (*tcl_SplitPath) (const char *path, size_t *argcPtr, const char ***argvPtr); /* 665 */ - Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, size_t *lenPtr); /* 666 */ - int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, size_t *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */ + int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 661 */ + int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 662 */ + int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr); /* 663 */ + int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 664 */ + void (*tcl_SplitPath) (const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 665 */ + Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 666 */ + int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */ Tcl_Size (*tcl_UniCharLen) (const int *uniStr); /* 668 */ Tcl_Size (*tcl_NumUtfChars) (const char *src, Tcl_Size length); /* 669 */ Tcl_Size (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */ @@ -2554,15 +2558,16 @@ typedef struct TclStubs { Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */ Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */ Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ - int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */ + int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]); /* 679 */ int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */ - int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ + int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ - void (*reserved686)(void); - void (*tclUnusedStubEntry) (void); /* 687 */ + int (*tcl_GetSizeIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); /* 686 */ + void (*reserved687)(void); + void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3887,9 +3892,11 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ -/* Slot 686 is reserved */ +#define Tcl_GetSizeIntFromObj \ + (tclStubsPtr->tcl_GetSizeIntFromObj) /* 686 */ +/* Slot 687 is reserved */ #define TclUnusedStubEntry \ - (tclStubsPtr->tclUnusedStubEntry) /* 687 */ + (tclStubsPtr->tclUnusedStubEntry) /* 688 */ #endif /* defined(USE_TCL_STUBS) */ @@ -3936,7 +3943,7 @@ extern const TclStubs *tclStubsPtr; #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) #define Tcl_AddErrorInfo(interp, message) \ - Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)) + Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1)) #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) #define Tcl_Eval(interp, objPtr) \ @@ -3948,7 +3955,7 @@ extern const TclStubs *tclStubsPtr; do { \ const char *__result = result; \ Tcl_FreeProc *__freeProc = freeProc; \ - Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, TCL_INDEX_NONE)); \ + Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \ if (__freeProc == TCL_DYNAMIC) { \ Tcl_Free((char *)__result); \ @@ -4020,19 +4027,31 @@ extern const TclStubs *tclStubsPtr; Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL) #define Tcl_GetUnicode(objPtr) \ Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL) -#undef Tcl_GetBytesFromObj +#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) +# undef Tcl_GetBytesFromObj +# undef Tcl_GetStringFromObj +# undef Tcl_GetUnicodeFromObj +#endif #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean -#undef Tcl_GetStringFromObj -#undef Tcl_GetUnicodeFromObj #undef TclGetByteArrayFromObj #undef Tcl_GetByteArrayFromObj #if defined(USE_TCL_STUBS) -#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (size_t *)(void *)(sizePtr))) +# if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) +# define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) +# define Tcl_GetStringFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \ + tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) +# define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ + (sizeof(*(sizePtr)) <= sizeof(int) ? \ + tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \ + tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) +# endif #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) @@ -4042,30 +4061,22 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) -#define Tcl_GetStringFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetStringFromObj(objPtr, (size_t *)(void *)(sizePtr))) #if TCL_MAJOR_VERSION > 8 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (size_t *)(void *)(sizePtr))) + tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \ + tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) #else #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (size_t *)(void *)(sizePtr))) + tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \ + tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) #endif -#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ - (sizeof(*(sizePtr)) <= sizeof(int) ? \ - tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (size_t *)(void *)(sizePtr))) #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ - (Tcl_GetBytesFromObj)(interp, objPtr, (size_t *)(void *)(sizePtr))) + TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \ + (Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) @@ -4077,16 +4088,16 @@ extern const TclStubs *tclStubsPtr; Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - (Tcl_GetStringFromObj)(objPtr, (size_t *)(void *)(sizePtr))) + TclGetStringFromObj(objPtr, (sizePtr)) : \ + (Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ - (Tcl_GetBytesFromObj)(NULL, objPtr, (size_t *)(void *)(sizePtr))) + TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \ + (Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ - TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ - (Tcl_GetUnicodeFromObj)(objPtr, (size_t *)(void *)(sizePtr))) + TclGetUnicodeFromObj(objPtr, (sizePtr)) : \ + (Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) #endif #ifdef TCL_MEM_DEBUG @@ -4158,34 +4169,36 @@ extern const TclStubs *tclStubsPtr; # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) +#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ - : tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) + ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \ + : tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # undef Tcl_ListObjLength # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ - ? tclStubsPtr->tclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ - : tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (size_t *)(void *)(lengthPtr))) + ? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \ + : tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # undef Tcl_DictObjSize # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ - ? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ - : tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (size_t *)(void *)(sizePtr))) + ? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \ + : tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # undef Tcl_SplitList # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ - : tclStubsPtr->tcl_SplitList((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr))) + ? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \ + : tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # undef Tcl_SplitPath # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ - : tclStubsPtr->tcl_SplitPath((path), (size_t *)(void *)(argcPtr), (argvPtr))) + ? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \ + : tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # undef Tcl_FSSplitPath # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ - ? tclStubsPtr->tclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ - : tclStubsPtr->tcl_FSSplitPath((pathPtr), (size_t *)(void *)(lenPtr))) + ? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \ + : tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ - ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ - : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv))) + ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \ + : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) +#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */ #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ @@ -4199,28 +4212,28 @@ extern const TclStubs *tclStubsPtr; # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) -#if !defined(BUILD_tcl) +#if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ - ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ - : (Tcl_ListObjGetElements)((interp), (listPtr), (size_t *)(void *)(objcPtr), (objvPtr))) + ? TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \ + : (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ - ? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ - : (Tcl_ListObjLength)((interp), (listPtr), (size_t *)(void *)(lengthPtr))) + ? TclListObjLength((interp), (listPtr), (lengthPtr)) \ + : (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ - ? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ - : (Tcl_DictObjSize)((interp), (dictPtr), (size_t *)(void *)(sizePtr))) + ? TclDictObjSize((interp), (dictPtr), (sizePtr)) \ + : (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ - : (Tcl_SplitList)((interp), (listStr), (size_t *)(void *)(argcPtr), (argvPtr))) + ? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \ + : (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ - ? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ - : (Tcl_SplitPath)((path), (size_t *)(void *)(argcPtr), (argvPtr))) + ? TclSplitPath((path), (argcPtr), (argvPtr)) \ + : (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ - ? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ - : (Tcl_FSSplitPath)((pathPtr), (size_t *)(void *)(lenPtr))) + ? TclFSSplitPath((pathPtr), (lenPtr)) \ + : (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ - ? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ - : (Tcl_ParseArgsObjv)((interp), (argTable), (size_t *)(void *)(objcPtr), (objv), (remObjv))) + ? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \ + : (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) #endif /* !defined(BUILD_tcl) */ #endif @@ -4233,42 +4246,6 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) -#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl) && TCL_MAJOR_VERSION > 8 -# ifdef USE_TCL_STUBS -# undef Tcl_Gets -# undef Tcl_GetsObj -# undef Tcl_Read -# undef Tcl_Ungets -# undef Tcl_Write -# undef Tcl_ReadChars -# undef Tcl_WriteChars -# undef Tcl_WriteObj -# undef Tcl_ReadRaw -# undef Tcl_WriteRaw -# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1) -# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1) -# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1) -# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1) -# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1) -# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) -# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1) -# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1) -# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) -# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1) -# else -# define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1) -# define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1) -# define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1) -# define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1) -# define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1) -# define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1) -# define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1) -# define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1) -# define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1) -# define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1) -# endif -#endif - #if TCL_MAJOR_VERSION > 8 # undef Tcl_Close # define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0) @@ -4283,4 +4260,10 @@ extern const TclStubs *tclStubsPtr; # define Tcl_GetMaster Tcl_GetParent #endif +/* TIP #660 for 8.7 */ +#if TCL_MAJOR_VERSION < 9 +# undef Tcl_GetSizeIntFromObj +# define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj +#endif + #endif /* _TCLDECLS */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 5c18c8aa9e28..f996f4bd2d67 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -489,7 +489,7 @@ UpdateStringOfDict( Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; - size_t i, length; + Tcl_Size i, length; TCL_HASH_TYPE bytesNeeded = 0; const char *elem; char *dst; @@ -499,7 +499,7 @@ UpdateStringOfDict( * is not exposed by any API function... */ - size_t numElems; + Tcl_Size numElems; DictGetInternalRep(dictPtr, dict); @@ -604,7 +604,7 @@ SetDictFromAny( */ if (TclHasInternalRep(objPtr, &tclListType.objType)) { - size_t objc, i; + Tcl_Size objc, i; Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ @@ -634,14 +634,14 @@ SetDictFromAny( Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { - size_t length; + Tcl_Size length; const char *nextElem = Tcl_GetStringFromObj(objPtr, &length); const char *limit = (nextElem + length); while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; - size_t elemSize; + Tcl_Size elemSize; int literal; if (TclFindDictElement(interp, nextElem, (limit - nextElem), @@ -717,7 +717,7 @@ SetDictFromAny( missingValue: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value to go with key", TCL_INDEX_NONE)); + "missing value to go with key", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); } errorInFindDictElement: @@ -769,7 +769,7 @@ GetDictFromObj( * the chain fields of the dictionaries (for easy invalidation of string * representations using InvalidateDictChain). If the flags argument has * the DICT_PATH_CREATE bits set (and not the DICT_PATH_EXISTS bit), - * non-existant keys will be inserted with a value of an empty + * non-extant keys will be inserted with a value of an empty * dictionary, resulting in the path being built. * *---------------------------------------------------------------------- @@ -779,12 +779,12 @@ Tcl_Obj * TclTraceDictPath( Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t keyc, + Tcl_Size keyc, Tcl_Obj *const keyv[], int flags) { Dict *dict, *newDict; - size_t i; + Tcl_Size i; DictGetInternalRep(dictPtr, dict); if (dict == NULL) { @@ -862,7 +862,7 @@ TclTraceDictPath( * * InvalidateDictChain -- * - * Go through a dictionary chain (built by an updating invokation of + * Go through a dictionary chain (built by an updating invocation of * TclTraceDictPath) and invalidate the string representations of all the * dictionaries on the chain. * @@ -1068,7 +1068,7 @@ int Tcl_DictObjSize( Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t *sizePtr) + Tcl_Size *sizePtr) { Dict *dict; @@ -1188,7 +1188,7 @@ Tcl_DictObjNext( ChainEntry *cPtr; /* - * If the searh is done; we do no work. + * If the search is done; we do no work. */ if (!searchPtr->epoch) { @@ -1281,7 +1281,7 @@ int Tcl_DictObjPutKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t keyc, + Tcl_Size keyc, Tcl_Obj *const keyv[], Tcl_Obj *valuePtr) { @@ -1292,7 +1292,7 @@ Tcl_DictObjPutKeyList( if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList"); } - if (keyc + 1 < 2) { + if (keyc < 1) { Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList"); } @@ -1342,7 +1342,7 @@ int Tcl_DictObjRemoveKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t keyc, + Tcl_Size keyc, Tcl_Obj *const keyv[]) { Dict *dict; @@ -2025,7 +2025,7 @@ DictSizeCmd( Tcl_Obj *const *objv) { int result; - size_t size; + Tcl_Size size; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); @@ -2119,7 +2119,7 @@ DictInfoCmd( } statsStr = Tcl_HashStats(&dict->table); - Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); Tcl_Free(statsStr); return TCL_OK; } @@ -2463,7 +2463,7 @@ DictForNRCmd( Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; Tcl_DictSearch *searchPtr; - size_t varc; + Tcl_Size varc; int done; if (objc != 4) { @@ -2481,7 +2481,7 @@ DictForNRCmd( } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", TCL_INDEX_NONE)); + "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL); return TCL_ERROR; } @@ -2658,7 +2658,7 @@ DictMapNRCmd( Interp *iPtr = (Interp *) interp; Tcl_Obj **varv, *keyObj, *valueObj; DictMapStorage *storagePtr; - size_t varc; + Tcl_Size varc; int done; if (objc != 4) { @@ -2676,7 +2676,7 @@ DictMapNRCmd( } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", TCL_INDEX_NONE)); + "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL); return TCL_ERROR; } @@ -2998,7 +2998,7 @@ DictFilterCmd( Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj; Tcl_DictSearch search; int done, result, satisfied; - size_t varc; + Tcl_Size varc; const char *pattern; if (objc < 3) { @@ -3116,7 +3116,7 @@ DictFilterCmd( } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must have exactly two variable names", TCL_INDEX_NONE)); + "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL); return TCL_ERROR; } @@ -3276,7 +3276,7 @@ DictUpdateCmd( Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i; - size_t dummy; + Tcl_Size dummy; if (objc < 5 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -3329,7 +3329,7 @@ FinalizeDictUpdate( { Tcl_Obj *dictPtr, *objPtr, **objv; Tcl_InterpState state; - size_t i, objc; + Tcl_Size i, objc; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *argsObj = (Tcl_Obj *)data[1]; @@ -3479,7 +3479,7 @@ FinalizeDictWith( int result) { Tcl_Obj **pathv; - size_t pathc; + Tcl_Size pathc; Tcl_InterpState state; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *keysPtr = (Tcl_Obj *)data[1]; @@ -3556,14 +3556,14 @@ Tcl_Obj * TclDictWithInit( Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t pathc, + Tcl_Size pathc, Tcl_Obj *const pathv[]) { Tcl_DictSearch s; Tcl_Obj *keyPtr, *valPtr, *keysPtr; int done; - if (pathc + 1 > 1) { + if (pathc > 0) { dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv, DICT_PATH_READ); if (dictPtr == NULL) { @@ -3643,7 +3643,7 @@ TclDictWithFinish( * the result value from TclDictWithInit. */ { Tcl_Obj *dictPtr, *leafPtr, *valPtr; - size_t i, allocdict, keyc; + Tcl_Size i, allocdict, keyc; Tcl_Obj **keyv; /* @@ -3674,9 +3674,9 @@ TclDictWithFinish( if (pathc > 0) { /* * Want to get to the dictionary which we will update; need to do - * prepare-for-update de-sharing along the path *but* avoid generating - * an error on a non-existant path (we'll treat that the same as a - * non-existant variable. Luckily, the de-sharing operation isn't + * prepare-for-update unsharing along the path *but* avoid generating + * an error on a non-extant path (we'll treat that the same as a + * non-extant variable. Luckily, the unsharing operation isn't * deeply damaging if we don't go on to update; it's just less than * perfectly efficient (but no memory should be leaked). */ diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index c06731f04341..db781db65320 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -28,7 +28,7 @@ static int FormatInstruction(ByteCode *codePtr, static void GetLocationInformation(Proc *procPtr, Tcl_Obj **fileObjPtr, int *linePtr); static void PrintSourceToObj(Tcl_Obj *appendObj, - const char *stringPtr, size_t maxChars); + const char *stringPtr, Tcl_Size maxChars); static void UpdateStringOfInstName(Tcl_Obj *objPtr); /* @@ -194,10 +194,10 @@ TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ - size_t maxChars) /* Maximum number of chars to print. */ + Tcl_Size maxChars) /* Maximum number of chars to print. */ { char *bytes; - size_t length; + Tcl_Size length; bytes = Tcl_GetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); @@ -225,7 +225,7 @@ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ - size_t maxChars) /* Maximum number of chars to print. */ + Tcl_Size maxChars) /* Maximum number of chars to print. */ { Tcl_Obj *bufferObj; @@ -280,7 +280,7 @@ DisassembleByteCodeObj( Tcl_AppendPrintfToObj(bufferObj, "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); - Tcl_AppendToObj(bufferObj, " Source ", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(codePtr->procPtr, &fileObj, &line); @@ -339,7 +339,7 @@ DisassembleByteCodeObj( (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "", (localPtr->flags & VAR_RESOLVED) ? ", resolved" : ""); if (TclIsVarTemporary(localPtr)) { - Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "\n", -1); } else { Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n", localPtr->name); @@ -389,7 +389,7 @@ DisassembleByteCodeObj( if (numCmds == 0) { pc = codeStart; while (pc < codeLimit) { - Tcl_AppendToObj(bufferObj, " ", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } return bufferObj; @@ -451,7 +451,7 @@ DisassembleByteCodeObj( srcOffset, (srcOffset + srcLen - 1)); } if (numCmds > 0) { - Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "\n", -1); } /* @@ -500,14 +500,14 @@ DisassembleByteCodeObj( */ while ((pc-codeStart) < codeOffset) { - Tcl_AppendToObj(bufferObj, " ", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1); PrintSourceToObj(bufferObj, (codePtr->source + srcOffset), TclMin(srcLen, 55)); - Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "\n", -1); } if (pc < codeLimit) { /* @@ -515,7 +515,7 @@ DisassembleByteCodeObj( */ while (pc < codeLimit) { - Tcl_AppendToObj(bufferObj, " ", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } } @@ -571,22 +571,22 @@ FormatInstruction( case OPERAND_UINT4: opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { - sprintf(suffixBuffer+strlen(suffixBuffer), + snprintf(suffixBuffer+strlen(suffixBuffer), sizeof(suffixBuffer) - strlen(suffixBuffer), ", %u cmds start here", opnd); } Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd); break; case OPERAND_OFFSET1: opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++; - sprintf(suffixBuffer, "pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; case OPERAND_OFFSET4: opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4; if (opCode == INST_START_CMD) { - sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "next cmd at pc %u", pcOffset+opnd); } else { - sprintf(suffixBuffer, "pc %u", pcOffset+opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "pc %u", pcOffset+opnd); } Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd); break; @@ -632,9 +632,9 @@ FormatInstruction( localPtr = localPtr->nextPtr; } if (TclIsVarTemporary(localPtr)) { - sprintf(suffixBuffer, "temp var %u", opnd); + snprintf(suffixBuffer, sizeof(suffixBuffer), "temp var %u", opnd); } else { - sprintf(suffixBuffer, "var "); + snprintf(suffixBuffer, sizeof(suffixBuffer), "var "); suffixSrc = localPtr->name; } } @@ -652,9 +652,9 @@ FormatInstruction( } if (suffixObj) { const char *bytes; - size_t length; + Tcl_Size length; - Tcl_AppendToObj(bufferObj, "\t# ", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length); PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { @@ -663,12 +663,12 @@ FormatInstruction( PrintSourceToObj(bufferObj, suffixSrc, 40); } } - Tcl_AppendToObj(bufferObj, "\n", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "\n", -1); if (auxPtr && auxPtr->type->printProc) { - Tcl_AppendToObj(bufferObj, "\t\t[", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "\t\t[", -1); auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr, pcOffset); - Tcl_AppendToObj(bufferObj, "]\n", TCL_INDEX_NONE); + Tcl_AppendToObj(bufferObj, "]\n", -1); } return numBytes; } @@ -690,7 +690,7 @@ TclGetInnerContext( const unsigned char *pc, Tcl_Obj **tosPtr) { - size_t objc = 0; + Tcl_Size objc = 0; Tcl_Obj *result; Interp *iPtr = (Interp *) interp; @@ -759,7 +759,7 @@ TclGetInnerContext( iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); Tcl_IncrRefCount(result); } else { - size_t len; + Tcl_Size len; /* * Reset while keeping the list internalrep as much as possible. @@ -836,7 +836,7 @@ UpdateStringOfInstName( if (inst >= LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst); + snprintf(dst, TCL_INTEGER_SPACE + 5, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; @@ -860,17 +860,17 @@ static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ - size_t maxChars) /* Maximum number of chars to print. */ + Tcl_Size maxChars) /* Maximum number of chars to print. */ { const char *p; - size_t i = 0, len; + Tcl_Size i = 0, len; if (stringPtr == NULL) { - Tcl_AppendToObj(appendObj, "\"\"", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\"\"", -1); return; } - Tcl_AppendToObj(appendObj, "\"", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\"", -1); p = stringPtr; for (; (*p != '\0') && (i < maxChars); p+=len) { int ucs4; @@ -878,27 +878,27 @@ PrintSourceToObj( len = TclUtfToUCS4(p, &ucs4); switch (ucs4) { case '"': - Tcl_AppendToObj(appendObj, "\\\"", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\\\"", -1); i += 2; continue; case '\f': - Tcl_AppendToObj(appendObj, "\\f", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\\f", -1); i += 2; continue; case '\n': - Tcl_AppendToObj(appendObj, "\\n", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\\n", -1); i += 2; continue; case '\r': - Tcl_AppendToObj(appendObj, "\\r", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\\r", -1); i += 2; continue; case '\t': - Tcl_AppendToObj(appendObj, "\\t", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\\t", -1); i += 2; continue; case '\v': - Tcl_AppendToObj(appendObj, "\\v", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: @@ -916,9 +916,9 @@ PrintSourceToObj( } } if (*p != '\0') { - Tcl_AppendToObj(appendObj, "...", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "...", -1); } - Tcl_AppendToObj(appendObj, "\"", TCL_INDEX_NONE); + Tcl_AppendToObj(appendObj, "\"", -1); } /* @@ -972,33 +972,33 @@ DisassembleByteCodeAsDicts( TclNewObj(descriptor[0]); if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) { Tcl_ListObjAppendElement(NULL, descriptor[0], - Tcl_NewStringObj("scalar", TCL_INDEX_NONE)); + Tcl_NewStringObj("scalar", -1)); } if (localPtr->flags & VAR_ARRAY) { Tcl_ListObjAppendElement(NULL, descriptor[0], - Tcl_NewStringObj("array", TCL_INDEX_NONE)); + Tcl_NewStringObj("array", -1)); } if (localPtr->flags & VAR_LINK) { Tcl_ListObjAppendElement(NULL, descriptor[0], - Tcl_NewStringObj("link", TCL_INDEX_NONE)); + Tcl_NewStringObj("link", -1)); } if (localPtr->flags & VAR_ARGUMENT) { Tcl_ListObjAppendElement(NULL, descriptor[0], - Tcl_NewStringObj("arg", TCL_INDEX_NONE)); + Tcl_NewStringObj("arg", -1)); } if (localPtr->flags & VAR_TEMPORARY) { Tcl_ListObjAppendElement(NULL, descriptor[0], - Tcl_NewStringObj("temp", TCL_INDEX_NONE)); + Tcl_NewStringObj("temp", -1)); } if (localPtr->flags & VAR_RESOLVED) { Tcl_ListObjAppendElement(NULL, descriptor[0], - Tcl_NewStringObj("resolved", TCL_INDEX_NONE)); + Tcl_NewStringObj("resolved", -1)); } if (localPtr->flags & VAR_TEMPORARY) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewListObj(1, descriptor)); } else { - descriptor[1] = Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE); + descriptor[1] = Tcl_NewStringObj(localPtr->name, -1); Tcl_ListObjAppendElement(NULL, variables, Tcl_NewListObj(2, descriptor)); } @@ -1016,7 +1016,7 @@ DisassembleByteCodeAsDicts( TclNewObj(inst); Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( - instDesc->name, TCL_INDEX_NONE)); + instDesc->name, -1)); opnd = pc + 1; for (i=0 ; inumOperands ; i++) { switch (instDesc->opTypes[i]) { @@ -1082,7 +1082,7 @@ DisassembleByteCodeAsDicts( ".%d", val)); } else if (val == -2) { Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( - ".end", TCL_INDEX_NONE)); + ".end", -1)); } else { Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( ".end-%d", -2-val)); @@ -1115,13 +1115,13 @@ DisassembleByteCodeAsDicts( TclNewObj(aux); for (i=0 ; i<(int)codePtr->numAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; - Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, TCL_INDEX_NONE); + Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1); if (auxData->type->disassembleProc) { Tcl_Obj *desc; TclNewObj(desc); - Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", TCL_INDEX_NONE), auxDesc); + Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc); auxDesc = desc; auxData->type->disassembleProc(auxData->clientData, auxDesc, codePtr, 0); @@ -1188,9 +1188,9 @@ DisassembleByteCodeAsDicts( sourceOffset += Decode(srcOffPtr); sourceLength = Decode(srcLenPtr); TclNewObj(cmd); - Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1), Tcl_NewWideIntObj(codeOffset)); - Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1), Tcl_NewWideIntObj(codeOffset + codeLength - 1)); /* @@ -1198,13 +1198,13 @@ DisassembleByteCodeAsDicts( * characters are present in the source! */ - Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1), Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source, sourceOffset))); - Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1), Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source, sourceOffset + sourceLength - 1))); - Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1), Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength)); Tcl_ListObjAppendElement(NULL, commands, cmd); } @@ -1223,32 +1223,32 @@ DisassembleByteCodeAsDicts( */ TclNewObj(description); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1), literals); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1), variables); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", TCL_INDEX_NONE), exn); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn); + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1), instructions); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", TCL_INDEX_NONE), aux); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux); + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1), commands); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1), Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes)); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", TCL_INDEX_NONE), - Tcl_NewStringObj(codePtr->nsPtr->fullName, TCL_INDEX_NONE)); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1), + Tcl_NewStringObj(codePtr->nsPtr->fullName, -1)); + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1), Tcl_NewWideIntObj(codePtr->maxStackDepth)); - Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1), Tcl_NewWideIntObj(codePtr->maxExceptDepth)); if (line >= 0) { Tcl_DictObjPut(NULL, description, - Tcl_NewStringObj("initiallinenumber", TCL_INDEX_NONE), + Tcl_NewStringObj("initiallinenumber", -1), Tcl_NewWideIntObj(line)); } if (file) { Tcl_DictObjPut(NULL, description, - Tcl_NewStringObj("sourcefile", TCL_INDEX_NONE), file); + Tcl_NewStringObj("sourcefile", -1), file); } return description; } @@ -1410,7 +1410,7 @@ Tcl_DisassembleObjCmd( procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "body not available for this kind of constructor", TCL_INDEX_NONE)); + "body not available for this kind of constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; @@ -1475,7 +1475,7 @@ Tcl_DisassembleObjCmd( procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "body not available for this kind of destructor", TCL_INDEX_NONE)); + "body not available for this kind of destructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; @@ -1565,7 +1565,7 @@ Tcl_DisassembleObjCmd( procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "body not available for this kind of method", TCL_INDEX_NONE)); + "body not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; @@ -1602,7 +1602,7 @@ Tcl_DisassembleObjCmd( if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not disassemble prebuilt bytecode", TCL_INDEX_NONE)); + "may not disassemble prebuilt bytecode", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "BYTECODE", NULL); return TCL_ERROR; diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index a87eb7f1e357..b794eb204398 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -10,7 +10,6 @@ */ #include "tclInt.h" -#include "tclIO.h" typedef size_t (LengthProc)(const char *src); @@ -200,16 +199,16 @@ static struct TclEncodingProfiles { {"tcl8", TCL_ENCODING_PROFILE_TCL8}, }; #define PROFILE_TCL8(flags_) \ - ((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) \ - || (CHANNEL_PROFILE_GET(flags_) == 0 \ + ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8) \ + || (ENCODING_PROFILE_GET(flags_) == 0 \ && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_TCL8)) #define PROFILE_STRICT(flags_) \ - ((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \ - || (CHANNEL_PROFILE_GET(flags_) == 0 \ + ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \ + || (ENCODING_PROFILE_GET(flags_) == 0 \ && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_STRICT)) #define PROFILE_REPLACE(flags_) \ - ((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \ - || (CHANNEL_PROFILE_GET(flags_) == 0 \ + ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \ + || (ENCODING_PROFILE_GET(flags_) == 0 \ && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_REPLACE)) #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD) @@ -610,7 +609,7 @@ TclInitEncodingSubsystem(void) type.nullSize = 1; type.clientData = INT2PTR(ENCODING_UTF); Tcl_CreateEncoding(&type); - type.clientData = INT2PTR(0); + type.clientData = NULL; type.encodingName = "cesu-8"; Tcl_CreateEncoding(&type); @@ -622,7 +621,7 @@ TclInitEncodingSubsystem(void) type.clientData = INT2PTR(TCL_ENCODING_LE); Tcl_CreateEncoding(&type); type.encodingName = "ucs-2be"; - type.clientData = INT2PTR(0); + type.clientData = NULL; Tcl_CreateEncoding(&type); type.encodingName = "ucs-2"; type.clientData = INT2PTR(leFlags); @@ -636,7 +635,7 @@ TclInitEncodingSubsystem(void) type.clientData = INT2PTR(TCL_ENCODING_LE); Tcl_CreateEncoding(&type); type.encodingName = "utf-32be"; - type.clientData = INT2PTR(0); + type.clientData = NULL; Tcl_CreateEncoding(&type); type.encodingName = "utf-32"; type.clientData = INT2PTR(leFlags); @@ -647,13 +646,13 @@ TclInitEncodingSubsystem(void) type.freeProc = NULL; type.nullSize = 2; type.encodingName = "utf-16le"; - type.clientData = INT2PTR(TCL_ENCODING_LE|ENCODING_UTF); + type.clientData = INT2PTR(TCL_ENCODING_LE); Tcl_CreateEncoding(&type); type.encodingName = "utf-16be"; - type.clientData = INT2PTR(ENCODING_UTF); + type.clientData = NULL; Tcl_CreateEncoding(&type); type.encodingName = "utf-16"; - type.clientData = INT2PTR(leFlags|ENCODING_UTF); + type.clientData = INT2PTR(leFlags); Tcl_CreateEncoding(&type); #ifndef TCL_NO_DEPRECATED @@ -1299,7 +1298,7 @@ Tcl_ExternalToUtfDStringEx( /* Caller wants error message on failure */ if (result != TCL_OK && interp != NULL) { char buf[TCL_INTEGER_SPACE]; - sprintf(buf, "%" TCL_Z_MODIFIER "u", nBytesProcessed); + snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed); Tcl_SetObjResult( interp, Tcl_ObjPrintf("unexpected byte sequence starting at index %" @@ -1415,9 +1414,9 @@ Tcl_ExternalToUtf( } if (!noTerminate) { - if ((int) dstLen < 1) { - return TCL_CONVERT_NOSPACE; - } + if (dstLen < 1) { + return TCL_CONVERT_NOSPACE; + } /* * If there are any null characters in the middle of the buffer, * they will converted to the UTF-8 null character (\xC0\x80). To get @@ -1612,9 +1611,9 @@ Tcl_UtfToExternalDStringEx( if ((result != TCL_CONVERT_NOSPACE) && !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); - size_t i = soFar + encodingPtr->nullSize - 1; + Tcl_Size i = soFar + encodingPtr->nullSize - 1; /* Loop as DStringSetLength only stores one nul byte at a time */ - while (i+1 >= soFar+1) { + while (i >= soFar) { Tcl_DStringSetLength(dstPtr, i--); } if (errorLocPtr) { @@ -1630,7 +1629,7 @@ Tcl_UtfToExternalDStringEx( int ucs4; char buf[TCL_INTEGER_SPACE]; TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4); - sprintf(buf, "%" TCL_Z_MODIFIER "u", nBytesProcessed); + snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed); Tcl_SetObjResult( interp, Tcl_ObjPrintf( @@ -2532,7 +2531,17 @@ UtfToUtfProc( flags |= PTR2INT(clientData); dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6); - profile = CHANNEL_PROFILE_GET(flags); + +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, dstLen); +#endif + + profile = ENCODING_PROFILE_GET(flags); for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) { @@ -2570,8 +2579,7 @@ UtfToUtfProc( } } else { /* - * Convert 0xC080 to real nulls when we are in output mode, - * irrespective of the profile. + * For output convert 0xC080 to a real null. */ *dst++ = 0; src += 2; @@ -2747,6 +2755,15 @@ Utf32ToUtfProc( } result = TCL_OK; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, dstLen); +#endif + /* * Check alignment with utf-32 (4 == sizeof(UTF-32)) */ @@ -2787,9 +2804,9 @@ Utf32ToUtfProc( int prev = ch; #endif if (flags & TCL_ENCODING_LE) { - ch = (src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF); + ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF); } else { - ch = (src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF); + ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF); } #if TCL_UTF_MAX < 4 if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) { @@ -2822,6 +2839,11 @@ Utf32ToUtfProc( if ((unsigned)ch - 1 < 0x7F) { *dst++ = (ch & 0xFF); } else { +#if TCL_UTF_MAX < 4 + if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) { + *dst = 0; /* In case of lower surrogate, don't try to combine */ + } +#endif dst += Tcl_UniCharToUtf(ch, dst); } src += 4; @@ -3011,6 +3033,15 @@ Utf16ToUtfProc( } result = TCL_OK; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, dstLen); +#endif + /* * Check alignment with utf-16 (2 == sizeof(UTF-16)) */ @@ -3424,6 +3455,15 @@ TableToUtfProc( dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, dstLen); +#endif + toUnicode = (const unsigned short *const *) dataPtr->toUnicode; prefixBytes = dataPtr->prefixBytes; pageZero = toUnicode[0]; @@ -3475,7 +3515,7 @@ TableToUtfProc( } /* - * Special case for 1-byte utf chars for speed. + * Special case for 1-byte Utf chars for speed. */ if ((unsigned)ch - 1 < 0x7F) { @@ -3665,6 +3705,15 @@ Iso88591ToUtfProc( dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, dstLen); +#endif + result = TCL_OK; for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) { Tcl_UniChar ch = 0; @@ -3904,6 +3953,15 @@ EscapeToUtfProc( dstStart = dst; dstEnd = dst + dstLen - TCL_UTF_MAX; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, dstLen); +#endif + state = PTR2INT(*statePtr); if (flags & TCL_ENCODING_START) { state = 0; @@ -4583,9 +4641,9 @@ TclEncodingProfileIdToName( int TclEncodingSetProfileFlags(int flags) { if (flags & TCL_ENCODING_STOPONERROR) { - CHANNEL_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT); + ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT); } else { - int profile = CHANNEL_PROFILE_GET(flags); + int profile = ENCODING_PROFILE_GET(flags); switch (profile) { case TCL_ENCODING_PROFILE_TCL8: case TCL_ENCODING_PROFILE_STRICT: @@ -4593,7 +4651,7 @@ int TclEncodingSetProfileFlags(int flags) break; case 0: /* Unspecified by caller */ default: - CHANNEL_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT); + ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT); break; } } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 98f4ae0b1931..1a2fa1452934 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -106,7 +106,7 @@ static const Tcl_ObjType ensembleCmdType = { */ typedef struct { - size_t epoch; /* Used to confirm when the data in this + Tcl_Size epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this @@ -125,7 +125,7 @@ NewNsObj( if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } - return Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); + return Tcl_NewStringObj(nsPtr->fullName, -1); } /* @@ -189,7 +189,7 @@ TclNamespaceEnsembleCmd( switch (index) { case ENS_CREATE: { const char *name; - size_t len; + Tcl_Size len; int allocatedMapFlag = 0; /* * Defaults @@ -289,7 +289,7 @@ TclNamespaceEnsembleCmd( if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " - "must be non-empty lists", TCL_INDEX_NONE)); + "must be non-empty lists", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); @@ -460,7 +460,7 @@ TclNamespaceEnsembleCmd( /* -map option */ Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], TCL_INDEX_NONE)); + Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], -1)); Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); @@ -475,14 +475,14 @@ TclNamespaceEnsembleCmd( /* -parameters option */ Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], TCL_INDEX_NONE)); + Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1)); Tcl_GetEnsembleParameterList(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -prefix option */ Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], TCL_INDEX_NONE)); + Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], -1)); Tcl_GetEnsembleFlags(NULL, token, &flags); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX)); @@ -503,7 +503,7 @@ TclNamespaceEnsembleCmd( Tcl_SetObjResult(interp, resultObj); } else { - size_t len; + Tcl_Size len; int allocatedMapFlag = 0; Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL, *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */ @@ -577,7 +577,7 @@ TclNamespaceEnsembleCmd( if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " - "must be non-empty lists", TCL_INDEX_NONE)); + "must be non-empty lists", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); @@ -625,7 +625,7 @@ TclNamespaceEnsembleCmd( } case CONF_NAMESPACE: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "option -namespace is read-only", TCL_INDEX_NONE)); + "option -namespace is read-only", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY", NULL); goto freeMapAndError; @@ -798,12 +798,12 @@ Tcl_SetEnsembleSubcommandList( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (subcmdList != NULL) { - size_t length; + Tcl_Size length; if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) { return TCL_ERROR; @@ -870,11 +870,11 @@ Tcl_SetEnsembleParameterList( Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; - size_t length; + Tcl_Size length; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } @@ -950,12 +950,12 @@ Tcl_SetEnsembleMappingDict( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (mapDict != NULL) { - size_t size; + Tcl_Size size; int done; Tcl_DictSearch search; Tcl_Obj *valuePtr; @@ -1050,12 +1050,12 @@ Tcl_SetEnsembleUnknownHandler( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (unknownList != NULL) { - size_t length; + Tcl_Size length; if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) { return TCL_ERROR; @@ -1116,7 +1116,7 @@ Tcl_SetEnsembleFlags( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } @@ -1193,7 +1193,7 @@ Tcl_GetEnsembleSubcommandList( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; @@ -1235,7 +1235,7 @@ Tcl_GetEnsembleParameterList( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; @@ -1277,7 +1277,7 @@ Tcl_GetEnsembleMappingDict( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; @@ -1318,7 +1318,7 @@ Tcl_GetEnsembleUnknownHandler( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; @@ -1359,7 +1359,7 @@ Tcl_GetEnsembleFlags( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; @@ -1400,7 +1400,7 @@ Tcl_GetEnsembleNamespace( if (cmdPtr->objProc != TclEnsembleImplementationCmd) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command is not an ensemble", TCL_INDEX_NONE)); + "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); } return TCL_ERROR; @@ -1539,7 +1539,7 @@ TclMakeEnsemble( Tcl_DString buf, hiddenBuf; const char **nameParts = NULL; const char *cmdName = NULL; - size_t i, nameCount = 0; + Tcl_Size i, nameCount = 0; int ensembleFlags = 0, hiddenLen; /* @@ -1549,7 +1549,7 @@ TclMakeEnsemble( Tcl_DStringInit(&buf); Tcl_DStringInit(&hiddenBuf); TclDStringAppendLiteral(&hiddenBuf, "tcl:"); - Tcl_DStringAppend(&hiddenBuf, name, TCL_INDEX_NONE); + Tcl_DStringAppend(&hiddenBuf, name, -1); TclDStringAppendLiteral(&hiddenBuf, ":"); hiddenLen = Tcl_DStringLength(&hiddenBuf); if (name[0] == ':' && name[1] == ':') { @@ -1558,7 +1558,7 @@ TclMakeEnsemble( */ cmdName = name; - Tcl_DStringAppend(&buf, name, TCL_INDEX_NONE); + Tcl_DStringAppend(&buf, name, -1); ensembleFlags = TCL_ENSEMBLE_PREFIX; } else { /* @@ -1574,7 +1574,7 @@ TclMakeEnsemble( for (i = 0; i < nameCount; ++i) { TclDStringAppendLiteral(&buf, "::"); - Tcl_DStringAppend(&buf, nameParts[i], TCL_INDEX_NONE); + Tcl_DStringAppend(&buf, nameParts[i], -1); } } @@ -1619,10 +1619,10 @@ TclMakeEnsemble( TclDStringAppendLiteral(&buf, "::"); TclNewObj(mapDict); for (i=0 ; map[i].name != NULL ; i++) { - fromObj = Tcl_NewStringObj(map[i].name, TCL_INDEX_NONE); + fromObj = Tcl_NewStringObj(map[i].name, -1); TclNewStringObj(toObj, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)); - Tcl_AppendToObj(toObj, map[i].name, TCL_INDEX_NONE); + Tcl_AppendToObj(toObj, map[i].name, -1); Tcl_DictObjPut(NULL, mapDict, fromObj, toObj); if (map[i].proc || map[i].nreProc) { @@ -1640,7 +1640,7 @@ TclMakeEnsemble( map[i].nreProc, map[i].clientData, NULL); Tcl_DStringSetLength(&hiddenBuf, hiddenLen); if (Tcl_HideCommand(interp, "___tmp", - Tcl_DStringAppend(&hiddenBuf, map[i].name, TCL_INDEX_NONE))) { + Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) { Tcl_Panic("%s", Tcl_GetStringResult(interp)); } } else { @@ -1718,7 +1718,7 @@ NsEnsembleImplementationCmdNR( int reparseCount = 0; /* Number of reparses. */ Tcl_Obj *errorObj; /* Used for building error messages. */ Tcl_Obj *subObj; - size_t subIdx; + Tcl_Size subIdx; /* * Must recheck objc since numParameters might have changed. See test @@ -1727,7 +1727,7 @@ NsEnsembleImplementationCmdNR( restartEnsembleParse: subIdx = 1 + ensemblePtr->numParameters; - if ((size_t)objc < subIdx + 1) { + if (objc < subIdx + 1) { /* * No subcommand argument. Make error message. */ @@ -1737,7 +1737,7 @@ NsEnsembleImplementationCmdNR( Tcl_DStringInit(&buf); if (ensemblePtr->parameterList) { Tcl_DStringAppend(&buf, - TclGetString(ensemblePtr->parameterList), TCL_INDEX_NONE); + TclGetString(ensemblePtr->parameterList), -1); TclDStringAppendLiteral(&buf, " "); } TclDStringAppendLiteral(&buf, "subcommand ?arg ...?"); @@ -1754,7 +1754,7 @@ NsEnsembleImplementationCmdNR( if (!Tcl_InterpDeleted(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "ensemble activated for deleted namespace", TCL_INDEX_NONE)); + "ensemble activated for deleted namespace", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL); } return TCL_ERROR; @@ -1821,8 +1821,8 @@ NsEnsembleImplementationCmdNR( * it (a non-unique prefix produces an error). */ char *fullName = NULL; /* Full name of the subcommand. */ - size_t stringLength, i; - size_t tableLength = ensemblePtr->subcommandTable.numEntries; + Tcl_Size stringLength, i; + Tcl_Size tableLength = ensemblePtr->subcommandTable.numEntries; Tcl_Obj *fix; subcmdName = Tcl_GetStringFromObj(subObj, &stringLength); @@ -1869,7 +1869,7 @@ NsEnsembleImplementationCmdNR( * Record the spelling correction for usage message. */ - fix = Tcl_NewStringObj(fullName, TCL_INDEX_NONE); + fix = Tcl_NewStringObj(fullName, -1); /* * Cache for later in the subcommand object. @@ -1892,14 +1892,14 @@ NsEnsembleImplementationCmdNR( * * ((Q: That's not true if the -map option is used, is it?)) * - * but don't do that because cacheing of the command object should help. + * but don't do that because caching of the command object should help. */ { Tcl_Obj *copyPtr; /* The list of words to dispatch on. * Will be freed by the dispatch engine. */ Tcl_Obj **copyObjv; - size_t copyObjc, prefixObjc; + Tcl_Size copyObjc, prefixObjc; TclListObjLengthM(NULL, prefixObj, &prefixObjc); @@ -1980,12 +1980,12 @@ NsEnsembleImplementationCmdNR( (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""), TclGetString(subObj)); if (ensemblePtr->subcommandTable.numEntries == 1) { - Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], TCL_INDEX_NONE); + Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1); } else { - size_t i; + Tcl_Size i; for (i=0 ; isubcommandTable.numEntries-1 ; i++) { - Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], TCL_INDEX_NONE); + Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1); Tcl_AppendToObj(errorObj, ", ", 2); } Tcl_AppendPrintfToObj(errorObj, "or %s", @@ -2027,8 +2027,8 @@ TclClearRootEnsemble( int TclInitRewriteEnsemble( Tcl_Interp *interp, - size_t numRemoved, - size_t numInserted, + Tcl_Size numRemoved, + Tcl_Size numInserted, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; @@ -2040,7 +2040,7 @@ TclInitRewriteEnsemble( iPtr->ensembleRewrite.numRemovedObjs = numRemoved; iPtr->ensembleRewrite.numInsertedObjs = numInserted; } else { - size_t numIns = iPtr->ensembleRewrite.numInsertedObjs; + Tcl_Size numIns = iPtr->ensembleRewrite.numInsertedObjs; if (numIns < numRemoved) { iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns; @@ -2119,16 +2119,16 @@ void TclSpellFix( Tcl_Interp *interp, Tcl_Obj *const *objv, - size_t objc, - size_t badIdx, + Tcl_Size objc, + Tcl_Size badIdx, Tcl_Obj *bad, Tcl_Obj *fix) { Interp *iPtr = (Interp *) interp; Tcl_Obj *const *search; Tcl_Obj **store; - size_t idx; - size_t size; + Tcl_Size idx; + Tcl_Size size; if (iPtr->ensembleRewrite.sourceObjs == NULL) { iPtr->ensembleRewrite.sourceObjs = objv; @@ -2244,8 +2244,8 @@ Tcl_Obj *const * TclFetchEnsembleRoot( Tcl_Interp *interp, Tcl_Obj *const *objv, - size_t objc, - size_t *objcPtr) + Tcl_Size objc, + Tcl_Size *objcPtr) { Tcl_Obj *const *sourceObjs; Interp *iPtr = (Interp *) interp; @@ -2295,9 +2295,9 @@ EnsembleUnknownCallback( Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr) { - size_t paramc; + Tcl_Size paramc; int result; - size_t i, prefixObjc; + Tcl_Size i, prefixObjc; Tcl_Obj **paramv, *unknownCmd, *ensObj; /* @@ -2308,7 +2308,7 @@ EnsembleUnknownCallback( TclNewObj(ensObj); Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj); Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj); - for (i = 1 ; i < (size_t)objc ; i++) { + for (i = 1 ; i < objc ; i++) { Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]); } TclListObjGetElementsM(NULL, unknownCmd, ¶mc, ¶mv); @@ -2326,7 +2326,7 @@ EnsembleUnknownCallback( if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) { if (!Tcl_InterpDeleted(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown subcommand handler deleted its ensemble", TCL_INDEX_NONE)); + "unknown subcommand handler deleted its ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED", NULL); } @@ -2374,16 +2374,16 @@ EnsembleUnknownCallback( if (result != TCL_ERROR) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown subcommand handler returned bad code: ", TCL_INDEX_NONE)); + "unknown subcommand handler returned bad code: ", -1)); switch (result) { case TCL_RETURN: - Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1); break; case TCL_BREAK: - Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1); break; case TCL_CONTINUE: - Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1); break; default: Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result); @@ -2585,7 +2585,7 @@ BuildEnsembleConfig( { Tcl_HashSearch search; /* Used for scanning the commands in * the namespace for this ensemble. */ - size_t i, j; + Tcl_Size i, j; int isNew; Tcl_HashTable *hash = &ensemblePtr->subcommandTable; Tcl_HashEntry *hPtr; @@ -2596,7 +2596,7 @@ BuildEnsembleConfig( Tcl_InitHashTable(hash, TCL_STRING_KEYS); if (subList) { - size_t subc; + Tcl_Size subc; Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj; const char *name; @@ -2625,7 +2625,7 @@ BuildEnsembleConfig( name = TclGetString(subv[i+1]); hPtr = Tcl_CreateHashEntry(hash, name, &isNew); if (isNew) { - cmdObj = Tcl_NewStringObj(name, TCL_INDEX_NONE); + cmdObj = Tcl_NewStringObj(name, -1); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); @@ -2663,7 +2663,7 @@ BuildEnsembleConfig( * programmer (or [::unknown] of course) to provide the procedure. */ - cmdObj = Tcl_NewStringObj(name, TCL_INDEX_NONE); + cmdObj = Tcl_NewStringObj(name, -1); cmdPrefixObj = Tcl_NewListObj(1, &cmdObj); Tcl_SetHashValue(hPtr, cmdPrefixObj); Tcl_IncrRefCount(cmdPrefixObj); @@ -2928,12 +2928,12 @@ TclCompileEnsemble( Command *oldCmdPtr = cmdPtr, *newCmdPtr; int result, flags = 0, depth = 1, invokeAnyway = 0; int ourResult = TCL_ERROR; - size_t i, len, numBytes; + Tcl_Size i, len, numBytes; const char *word; TclNewObj(replaced); Tcl_IncrRefCount(replaced); - if ((int)parsePtr->numWords <= depth) { + if (parsePtr->numWords <= depth) { goto failed; } if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { @@ -2998,7 +2998,7 @@ TclCompileEnsemble( (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj); if (listObj != NULL) { - size_t sclen; + Tcl_Size sclen; const char *str; Tcl_Obj *matchObj = NULL; @@ -3255,20 +3255,20 @@ int TclAttemptCompileProc( Tcl_Interp *interp, Tcl_Parse *parsePtr, - size_t depth, + Tcl_Size depth, Command *cmdPtr, CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; int result; - size_t i; + Tcl_Size i; Tcl_Token *saveTokenPtr = parsePtr->tokenPtr; - size_t savedStackDepth = envPtr->currStackDepth; + Tcl_Size savedStackDepth = envPtr->currStackDepth; unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart; - size_t savedAuxDataArrayNext = envPtr->auxDataArrayNext; - size_t savedExceptArrayNext = envPtr->exceptArrayNext; + Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext; + Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext; #ifdef TCL_COMPILE_DEBUG - size_t savedExceptDepth = envPtr->exceptDepth; + Tcl_Size savedExceptDepth = envPtr->exceptDepth; #endif if (cmdPtr->compileProc == NULL) { @@ -3398,7 +3398,7 @@ CompileToInvokedCommand( Tcl_Obj *objPtr, **words; const char *bytes; int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; - size_t i, numWords, length; + Tcl_Size i, numWords, length; /* * Push the words of the command. Take care; the command words may be diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 6dae72a0426a..608ebf6edf55 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -50,7 +50,7 @@ static struct { * need to track this in case another * subsystem swaps around the environ array * like we do. */ - size_t ourEnvironSize; /* Non-zero means that the environ array was + Tcl_Size ourEnvironSize; /* Non-zero means that the environ array was * malloced and has this many total entries * allocated to it (not all may be in use at * once). Zero means that the environment @@ -185,8 +185,8 @@ TclSetupEnv( p1 = "COMSPEC"; } #endif - obj1 = Tcl_NewStringObj(p1, TCL_INDEX_NONE); - obj2 = Tcl_NewStringObj(p2, TCL_INDEX_NONE); + obj1 = Tcl_NewStringObj(p1, -1); + obj2 = Tcl_NewStringObj(p2, -1); Tcl_DStringFree(&envString); Tcl_IncrRefCount(obj1); @@ -253,8 +253,8 @@ TclSetEnv( const char *value) /* New value for variable (UTF-8). */ { Tcl_DString envString; - size_t nameLength, valueLength; - size_t index, length; + Tcl_Size nameLength, valueLength; + Tcl_Size index, length; char *p, *oldValue; const techar *p2; @@ -402,7 +402,7 @@ Tcl_PutEnv( } /* - * First convert the native string to UTF. Then separate the string into + * First convert the native string to Utf. Then separate the string into * name and value parts, and call TclSetEnv to do all of the real work. */ @@ -453,7 +453,7 @@ TclUnsetEnv( const char *name) /* Name of variable to remove (UTF-8). */ { char *oldValue; - size_t length, index; + Tcl_Size length, index; #ifdef USE_PUTENV_FOR_UNSET Tcl_DString envString; char *string; @@ -469,7 +469,7 @@ TclUnsetEnv( * needless work and to avoid recursion on the unset. */ - if (index == TCL_INDEX_NONE) { + if (index == -1) { Tcl_MutexUnlock(&envMutex); return; } @@ -568,13 +568,13 @@ TclGetEnv( * value of the environment variable is * stored. */ { - size_t length, index; + Tcl_Size length, index; const char *result; Tcl_MutexLock(&envMutex); index = TclpFindVariable(name, &length); result = NULL; - if (index != TCL_INDEX_NONE) { + if (index != -1) { Tcl_DString envStr; result = tenviron2utfdstr(tenviron[index], -1, &envStr); @@ -582,7 +582,7 @@ TclGetEnv( if (*result == '=') { result++; Tcl_DStringInit(valuePtr); - Tcl_DStringAppend(valuePtr, result, TCL_INDEX_NONE); + Tcl_DStringAppend(valuePtr, result, -1); result = Tcl_DStringValue(valuePtr); } else { result = NULL; diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 64935e612a71..68a2c977ee48 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -224,7 +224,7 @@ HandleBgErrors( Tcl_Preserve(interp); while (assocPtr->firstBgPtr != NULL) { int code; - size_t prefixObjc; + Tcl_Size prefixObjc; Tcl_Obj **prefixObjv, **tempObjv; /* @@ -281,7 +281,7 @@ HandleBgErrors( Tcl_DecrRefCount(keyPtr); Tcl_WriteChars(errChannel, - "error in background error handler:\n", TCL_INDEX_NONE); + "error in background error handler:\n", -1); if (valuePtr) { Tcl_WriteObj(errChannel, valuePtr); } else { @@ -343,7 +343,7 @@ TclDefaultBgErrorHandlerObjCmd( Tcl_DecrRefCount(keyPtr); if (result != TCL_OK || valuePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing return option \"-level\"", TCL_INDEX_NONE)); + "missing return option \"-level\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -356,7 +356,7 @@ TclDefaultBgErrorHandlerObjCmd( Tcl_DecrRefCount(keyPtr); if (result != TCL_OK || valuePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing return option \"-code\"", TCL_INDEX_NONE)); + "missing return option \"-code\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -474,17 +474,17 @@ TclDefaultBgErrorHandlerObjCmd( Tcl_RestoreInterpState(interp, saved); Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY)); - Tcl_WriteChars(errChannel, "\n", TCL_INDEX_NONE); + Tcl_WriteChars(errChannel, "\n", -1); } else { Tcl_DiscardInterpState(saved); Tcl_WriteChars(errChannel, - "bgerror failed to handle background error.\n", TCL_INDEX_NONE); - Tcl_WriteChars(errChannel, " Original error: ", TCL_INDEX_NONE); + "bgerror failed to handle background error.\n", -1); + Tcl_WriteChars(errChannel, " Original error: ", -1); Tcl_WriteObj(errChannel, tempObjv[1]); - Tcl_WriteChars(errChannel, "\n", TCL_INDEX_NONE); - Tcl_WriteChars(errChannel, " Error in bgerror: ", TCL_INDEX_NONE); + Tcl_WriteChars(errChannel, "\n", -1); + Tcl_WriteChars(errChannel, " Error in bgerror: ", -1); Tcl_WriteObj(errChannel, resultPtr); - Tcl_WriteChars(errChannel, "\n", TCL_INDEX_NONE); + Tcl_WriteChars(errChannel, "\n", -1); } Tcl_DecrRefCount(resultPtr); Tcl_Flush(errChannel); @@ -589,7 +589,7 @@ TclGetBgErrorHandler( * * This function is associated with the "tclBgError" assoc data for an * interpreter; it is invoked when the interpreter is deleted in order to - * free the information assoicated with any pending error reports. + * free the information associated with any pending error reports. * * Results: * None. @@ -957,7 +957,7 @@ Tcl_Exit( /* * Warning: this function SHOULD NOT return, as there is code that depends * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone - * returns, so critical is this dependcy. + * returns, so critical is this dependency. * * If subsystems are not (yet) initialized, proper Tcl-finalization is * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2]. @@ -1122,7 +1122,7 @@ Tcl_InitSubsystems(void) if (subsystemsInitialized == 0) { /* - * Double check inside the mutex. There are definitly calls back into + * Double check inside the mutex. There are definitely calls back into * this routine from some of the functions below. */ @@ -1572,7 +1572,7 @@ Tcl_VwaitObjCmd( if (timeout < 0) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "timeout must be positive", TCL_INDEX_NONE)); + "timeout must be positive", -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NEGTIME", NULL); result = TCL_ERROR; goto done; @@ -1652,7 +1652,7 @@ Tcl_VwaitObjCmd( if ((mask & (TCL_FILE_EVENTS | TCL_IDLE_EVENTS | TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't wait: would block forever", TCL_INDEX_NONE)); + "can't wait: would block forever", -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); result = TCL_ERROR; goto done; @@ -1660,7 +1660,7 @@ Tcl_VwaitObjCmd( if ((timeout > 0) && ((mask & TCL_TIMER_EVENTS) == 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "timer events disabled with timeout specified", TCL_INDEX_NONE)); + "timer events disabled with timeout specified", -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_TIME", NULL); result = TCL_ERROR; goto done; @@ -1688,7 +1688,7 @@ Tcl_VwaitObjCmd( for (i = 0; i < numItems; i++) { if (vwaitItems[i].mask) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "file events disabled with channel(s) specified", TCL_INDEX_NONE)); + "file events disabled with channel(s) specified", -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_FILE_EVENT", NULL); result = TCL_ERROR; goto done; @@ -1727,7 +1727,7 @@ Tcl_VwaitObjCmd( } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "LIMIT", NULL); break; } @@ -1975,7 +1975,7 @@ Tcl_UpdateObjCmd( } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); return TCL_ERROR; } } @@ -2047,8 +2047,8 @@ int Tcl_CreateThread( Tcl_ThreadId *idPtr, /* Return, the ID of the thread */ Tcl_ThreadCreateProc *proc, /* Main() function of the thread */ - void *clientData, /* The one argument to Main() */ - size_t stackSize, /* Size of stack for the new thread */ + void *clientData, /* The one argument to Main() */ + Tcl_Size stackSize, /* Size of stack for the new thread */ int flags) /* Flags controlling behaviour of the new * thread. */ { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 724a49e67318..647e3db9daa1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -635,7 +635,7 @@ static void FreeExprCodeInternalRep(Tcl_Obj *objPtr); static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc, int searchMode, ByteCode *codePtr); static const char * GetSrcInfoForPc(const unsigned char *pc, - ByteCode *codePtr, size_t *lengthPtr, + ByteCode *codePtr, Tcl_Size *lengthPtr, const unsigned char **pcBeg, int *cmdIdxPtr); static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, size_t growth, int move); @@ -981,10 +981,10 @@ GrowEvaluationStack( { ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL; size_t newBytes; - int growth = growth1; - int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); + Tcl_Size growth = growth1; + Tcl_Size newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr); Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart; - int moveWords = 0; + Tcl_Size moveWords = 0; if (move) { if (!markerPtr) { @@ -1224,10 +1224,10 @@ TclStackFree( void * TclStackAlloc( Tcl_Interp *interp, - size_t numBytes) + Tcl_Size numBytes) { Interp *iPtr = (Interp *) interp; - size_t numWords; + Tcl_Size numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { return (void *) Tcl_Alloc(numBytes); @@ -1240,13 +1240,13 @@ void * TclStackRealloc( Tcl_Interp *interp, void *ptr, - size_t numBytes) + Tcl_Size numBytes) { Interp *iPtr = (Interp *) interp; ExecEnv *eePtr; ExecStack *esPtr; Tcl_Obj **markerPtr; - size_t numWords; + Tcl_Size numWords; if (iPtr == NULL || iPtr->execEnvPtr == NULL) { return Tcl_Realloc(ptr, numBytes); @@ -1437,7 +1437,7 @@ CompileExprObj( * TIP #280: No invoker (yet) - Expression compilation. */ - size_t length; + Tcl_Size length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0); @@ -1634,7 +1634,7 @@ TclCompileObj( * Future optimizations ... * (1) Save the location data (ExtCmdLoc) keyed by start line. In that * case we recompile once per location of the literal, but not - * continously, because the moment we have all locations we do not + * continuously, because the moment we have all locations we do not * need to recompile any longer. * * (2) Alternative: Do not recompile, tell the execution engine the @@ -1680,7 +1680,7 @@ TclCompileObj( } } - if ((size_t)word < ctxCopyPtr->nline) { + if (word < ctxCopyPtr->nline) { /* * Note: We do not care if the line[word] is -1. This is a * difference and requires a recompile (location changed from @@ -1732,7 +1732,7 @@ TclCompileObj( * * TclIncrObj -- * - * Increment an integeral value in a Tcl_Obj by an integeral value held + * Increment an integral value in a Tcl_Obj by an integral value held * in another Tcl_Obj. Caller is responsible for making sure we can * update the first object. * @@ -1742,7 +1742,7 @@ TclCompileObj( * of course). * * Side effects: - * valuePtr gets the new incrmented value. + * valuePtr gets the new incremented value. * *---------------------------------------------------------------------- */ @@ -2049,7 +2049,7 @@ TEBCresume( Tcl_Obj *objPtr, *valuePtr, *value2Ptr, *part1Ptr, *part2Ptr, *tmpPtr; Tcl_Obj **objv = NULL; - size_t length, objc = 0; + Tcl_Size length, objc = 0; int opnd, pcAdjustment; Var *varPtr, *arrayPtr; #ifdef TCL_COMPILE_DEBUG @@ -2377,7 +2377,7 @@ TEBCresume( if (!corPtr) { TRACE_APPEND(("ERROR: yield outside coroutine\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", TCL_INDEX_NONE)); + "yield can only be called in a coroutine", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); @@ -2390,8 +2390,8 @@ TEBCresume( if (traceInstructions) { TRACE_APPEND(("YIELD...\n")); } else { - fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) yielding value \"%.30s\"\n", - iPtr->numLevels, (size_t)(pc - codePtr->codeStart), + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_T_MODIFIER "u) yielding value \"%.30s\"\n", + iPtr->numLevels, (pc - codePtr->codeStart), Tcl_GetString(OBJ_AT_TOS)); } fflush(stdout); @@ -2408,7 +2408,7 @@ TEBCresume( TRACE(("[%.30s] => ERROR: yield outside coroutine\n", O2S(valuePtr))); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", TCL_INDEX_NONE)); + "yieldto can only be called in a coroutine", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); @@ -2419,7 +2419,7 @@ TEBCresume( TRACE(("[%.30s] => ERROR: yield in deleted\n", O2S(valuePtr))); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto called in deleted namespace", TCL_INDEX_NONE)); + "yieldto called in deleted namespace", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", NULL); @@ -2433,8 +2433,8 @@ TEBCresume( TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr))); } else { /* FIXME: What is the right thing to trace? */ - fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) yielding to [%.30s]\n", - iPtr->numLevels, (size_t)(pc - codePtr->codeStart), + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_T_MODIFIER "u) yielding to [%.30s]\n", + iPtr->numLevels, (pc - codePtr->codeStart), TclGetString(valuePtr)); } fflush(stdout); @@ -2482,7 +2482,7 @@ TEBCresume( if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd)); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc or lambda", TCL_INDEX_NONE)); + "tailcall can only be called from a proc or lambda", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); CACHE_STACK_INFO(); @@ -2511,7 +2511,7 @@ TEBCresume( */ listPtr = Tcl_NewListObj(opnd, &OBJ_AT_DEPTH(opnd-1)); - nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, TCL_INDEX_NONE); + nsObjPtr = Tcl_NewStringObj(iPtr->varFramePtr->nsPtr->fullName, -1); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); if (iPtr->varFramePtr->tailcallPtr) { Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); @@ -2662,7 +2662,7 @@ TEBCresume( NEXT_INST_V(1, objc, 0); case INST_EXPAND_STKTOP: { - size_t i; + Tcl_Size i; TEBCdata *newTD; ptrdiff_t oldCatchTopOff, oldTosPtrOff; @@ -2789,14 +2789,14 @@ TEBCresume( #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { - size_t i; + Tcl_Size i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); TRACE(("%" TCL_Z_MODIFIER "u => call ", objc)); } else { - fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking ", iPtr->numLevels, - (size_t)(pc - codePtr->codeStart)); + fprintf(stdout, "%" TCL_Z_MODIFIER "d: (%" TCL_T_MODIFIER "u) invoking ", iPtr->numLevels, + (pc - codePtr->codeStart)); } for (i = 0; i < objc; i++) { TclPrintObject(stdout, objv[i], 15); @@ -2825,8 +2825,12 @@ TEBCresume( pc += pcAdjustment; TEBC_YIELD(); - return TclNREvalObjv(interp, objc, objv, + if (objc > INT_MAX) { + return TclCommandWordLimitError(interp, objc); + } else { + return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); + } case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); @@ -2836,19 +2840,19 @@ TEBCresume( cleanup = objc; #ifdef TCL_COMPILE_DEBUG if (tclTraceExec >= 2) { - size_t i; + Tcl_Size i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); TRACE(("%" TCL_Z_MODIFIER "u => call (implementation %s) ", objc, O2S(objPtr))); } else { fprintf(stdout, - "%" TCL_Z_MODIFIER "d: (%" TCL_Z_MODIFIER "u) invoking (using implementation %s) ", - iPtr->numLevels, (size_t)(pc - codePtr->codeStart), + "%" TCL_Z_MODIFIER "d: (%" TCL_T_MODIFIER "u) invoking (using implementation %s) ", + iPtr->numLevels, (pc - codePtr->codeStart), O2S(objPtr)); } for (i = 0; i < objc; i++) { - if (i < (size_t)opnd) { + if (i < opnd) { fprintf(stdout, "<"); TclPrintObject(stdout, objv[i], 15); fprintf(stdout, ">"); @@ -3047,7 +3051,7 @@ TEBCresume( { int storeFlags; - size_t len; + Tcl_Size len; case INST_STORE_ARRAY4: opnd = TclGetUInt4AtPtr(pc+1); @@ -3463,7 +3467,7 @@ TEBCresume( * Start of INST_INCR instructions. * * WARNING: more 'goto' here than your doctor recommended! The different - * instructions set the value of some variables and then jump to somme + * instructions set the value of some variables and then jump to some * common execution code. */ @@ -4352,7 +4356,7 @@ TEBCresume( Object *oPtr; CallFrame *framePtr; CallContext *contextPtr; - size_t skip, newDepth; + Tcl_Size skip, newDepth; case INST_TCLOO_SELF: framePtr = iPtr->varFramePtr; @@ -4404,7 +4408,7 @@ TEBCresume( } else { Class *classPtr = oPtr->classPtr; struct MInvoke *miPtr; - size_t i; + Tcl_Size i; const char *methodType; if (classPtr == NULL) { @@ -4431,7 +4435,7 @@ TEBCresume( iPtr->numLevels, (size_t)(pc - codePtr->codeStart)); } - for (i = 0; i < (size_t)opnd; i++) { + for (i = 0; i < opnd; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } @@ -4627,7 +4631,7 @@ TEBCresume( { int numIndices, nocase, match, cflags; - size_t slength, length2, fromIdx, toIdx, index, s1len, s2len; + Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len; const char *s1, *s2; case INST_LIST: @@ -4730,7 +4734,7 @@ TEBCresume( index = TclIndexDecode(opnd, length-1); /* Compute value @ index */ - if (index < length) { + if (index >= 0 && index < length) { objResultPtr = TclArithSeriesObjIndex(interp, valuePtr, index); if (objResultPtr == NULL) { CACHE_STACK_INFO(); @@ -4760,7 +4764,7 @@ TEBCresume( pcAdjustment = 5; lindexFastPath: - if (index < (size_t)objc) { + if (index >= 0 && index < objc) { objResultPtr = objv[index]; } else { TclNewObj(objResultPtr); @@ -4927,11 +4931,11 @@ TEBCresume( toIdx = TclIndexDecode(toIdx, objc - 1); if (toIdx == TCL_INDEX_NONE) { goto emptyList; - } else if (toIdx + 1 >= (size_t)objc + 1) { + } else if (toIdx >= objc) { toIdx = objc - 1; } - assert (toIdx < (size_t)objc); + assert (toIdx >= 0 && toIdx < objc); /* assert ( fromIdx != TCL_INDEX_NONE ); * @@ -4945,12 +4949,12 @@ TEBCresume( if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) { objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx); - if (objResultPtr == NULL) { - TRACE_ERROR(interp); - goto gotError; - } } else { - objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx); + objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx); + } + if (objResultPtr == NULL) { + TRACE_ERROR(interp); + goto gotError; } TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); @@ -4969,7 +4973,7 @@ TEBCresume( } match = 0; if (length > 0) { - size_t i = 0; + Tcl_Size i = 0; Tcl_Obj *o; int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType.objType); /* @@ -5146,7 +5150,7 @@ TEBCresume( { int checkEq = ((*pc == INST_EQ) || (*pc == INST_NEQ) || (*pc == INST_STR_EQ) || (*pc == INST_STR_NEQ)); - match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, TCL_INDEX_NONE); + match = TclStringCmp(valuePtr, value2Ptr, checkEq, 0, -1); } /* @@ -5256,7 +5260,7 @@ TEBCresume( TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr))); /* - * Get char length to calulate what 'end' means. + * Get char length to calculate what 'end' means. */ slength = Tcl_GetCharLength(valuePtr); @@ -5268,11 +5272,11 @@ TEBCresume( } CACHE_STACK_INFO(); - if (index >= slength) { + if (index < 0 || index >= slength) { TclNewObj(objResultPtr); } else if (TclIsPureByteArray(valuePtr)) { objResultPtr = Tcl_NewByteArrayObj( - Tcl_GetByteArrayFromObj(valuePtr, (size_t *)NULL)+index, 1); + Tcl_GetByteArrayFromObj(valuePtr, (Tcl_Size *)NULL)+index, 1); } else if (valuePtr->bytes && slength == valuePtr->length) { objResultPtr = Tcl_NewStringObj((const char *) valuePtr->bytes+index, 1); @@ -5356,7 +5360,7 @@ TEBCresume( { Tcl_UniChar *ustring1, *ustring2, *ustring3, *end, *p; - size_t length3; + Tcl_Size length3; Tcl_Obj *value3Ptr; case INST_STR_REPLACE: @@ -5381,23 +5385,23 @@ TEBCresume( TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); - if ((toIdx == TCL_INDEX_NONE) || - (fromIdx + 1 > slength + 1) || - (toIdx + 1 < fromIdx + 1)) { + if ((toIdx < 0) || + (fromIdx > slength) || + (toIdx < fromIdx)) { TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); TclDecrRefCount(value3Ptr); NEXT_INST_F(1, 0, 0); } - if (fromIdx == TCL_INDEX_NONE) { - fromIdx = TCL_INDEX_START; + if (fromIdx < 0) { + fromIdx = 0; } - if (toIdx + 1 > slength + 1) { + if (toIdx > slength) { toIdx = slength; } - if ((fromIdx == TCL_INDEX_START) && (toIdx == slength)) { + if ((fromIdx == 0) && (toIdx == slength)) { TclDecrRefCount(OBJ_AT_TOS); OBJ_AT_TOS = value3Ptr; TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); @@ -5454,7 +5458,7 @@ TEBCresume( for (; ustring1 < end; ustring1++) { if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ - ((size_t)(end-ustring1) >= length2) && (length2==1 || + ((end-ustring1) >= length2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { @@ -5488,7 +5492,7 @@ TEBCresume( NEXT_INST_F(1, 2, 1); case INST_STR_FIND_LAST: - objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1); + objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, TCL_SIZE_MAX - 1); TRACE(("%.20s %.20s => %s\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr))); @@ -5536,7 +5540,7 @@ TEBCresume( nocase); } else if (TclIsPureByteArray(valuePtr) && TclIsPureByteArray(value2Ptr) && !nocase) { unsigned char *bytes1, *bytes2; - size_t wlen1 = 0, wlen2 = 0; + Tcl_Size wlen1 = 0, wlen2 = 0; bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1); bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2); @@ -5561,7 +5565,7 @@ TEBCresume( { const char *string1, *string2; - size_t trim1, trim2; + Tcl_Size trim1, trim2; case INST_STR_TRIM_LEFT: valuePtr = OBJ_UNDER_TOS; /* String */ @@ -5840,7 +5844,7 @@ TEBCresume( case INST_RSHIFT: if (w2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "negative shift argument", TCL_INDEX_NONE)); + "negative shift argument", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", @@ -5889,7 +5893,7 @@ TEBCresume( case INST_LSHIFT: if (w2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "negative shift argument", TCL_INDEX_NONE)); + "negative shift argument", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", @@ -5912,7 +5916,7 @@ TEBCresume( */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", TCL_INDEX_NONE)); + "integer value too large to represent", -1)); #ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", @@ -6371,9 +6375,9 @@ TEBCresume( ForeachInfo *infoPtr; Tcl_Obj *listPtr, **elements; ForeachVarList *varListPtr; - size_t numLists, listLen, numVars, listTmpDepth; - size_t iterNum, iterMax, iterTmp; - size_t varIndex, valIndex, i, j; + Tcl_Size numLists, listLen, numVars, listTmpDepth; + Tcl_Size iterNum, iterMax, iterTmp; + Tcl_Size varIndex, valIndex, i, j; case INST_FOREACH_START: /* @@ -6636,14 +6640,14 @@ TEBCresume( { int opnd2, allocateDict, done, allocdict; - size_t i; + Tcl_Size i; Tcl_Obj *dictPtr, *statePtr, *keyPtr, *listPtr, *varNamePtr, *keysPtr; Tcl_Obj *emptyPtr, **keyPtrPtr; Tcl_DictSearch *searchPtr; DictUpdateInfo *duiPtr; case INST_DICT_VERIFY: { - size_t size; + Tcl_Size size; dictPtr = OBJ_AT_TOS; TRACE(("\"%.30s\" => ", O2S(dictPtr))); if (Tcl_DictObjSize(interp, dictPtr, &size) != TCL_OK) { @@ -7062,7 +7066,7 @@ TEBCresume( O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); /* - * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always + * The INST_DICT_FIRST and INST_DICT_NEXT instructions are always * followed by a conditional jump, so we can take advantage of this to * do some peephole optimization (note that we're careful to not close * out someone doing something else). @@ -7418,14 +7422,14 @@ TEBCresume( */ divideByZero: - Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; outOfMemory: - Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("out of memory", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "OUTOFMEMORY", "out of memory", NULL); CACHE_STACK_INFO(); @@ -7438,7 +7442,7 @@ TEBCresume( exponOfZero: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponentiation of zero by negative power", TCL_INDEX_NONE)); + "exponentiation of zero by negative power", -1)); DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", NULL); @@ -7466,7 +7470,7 @@ TEBCresume( } if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { const unsigned char *pcBeg; - size_t xxx1length; + Tcl_Size xxx1length; bytes = GetSrcInfoForPc(pc, codePtr, &xxx1length, &pcBeg, NULL); DECACHE_STACK_INFO(); @@ -7633,7 +7637,7 @@ TEBCresume( instStartCmdFailed: { const char *bytes; - size_t xxx1length; + Tcl_Size xxx1length; xxx1length = 0; @@ -7999,7 +8003,7 @@ ExecuteExtendedBinaryMathOp( } if (invalid) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "negative shift argument", TCL_INDEX_NONE)); + "negative shift argument", -1)); return GENERAL_ARITHMETIC_ERROR; } @@ -8030,7 +8034,7 @@ ExecuteExtendedBinaryMathOp( */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", TCL_INDEX_NONE)); + "integer value too large to represent", -1)); return GENERAL_ARITHMETIC_ERROR; } shift = (int)(*((const Tcl_WideInt *)ptr2)); @@ -8278,7 +8282,7 @@ ExecuteExtendedBinaryMathOp( if (type2 != TCL_NUMBER_INT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponent too large", TCL_INDEX_NONE)); + "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } @@ -8358,7 +8362,7 @@ ExecuteExtendedBinaryMathOp( || (value2Ptr->typePtr != &tclIntType.objType) || (Tcl_WideUInt)w2 >= (1<<28)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "exponent too large", TCL_INDEX_NONE)); + "exponent too large", -1)); return GENERAL_ARITHMETIC_ERROR; } Tcl_TakeBignumFromObj(NULL, valuePtr, &big1); @@ -9064,7 +9068,7 @@ TclGetSrcInfoForPc( ExtCmdLoc *eclPtr; ECL *locPtr = NULL; - size_t srcOffset; + Tcl_Size srcOffset; int i; Interp *iPtr = (Interp *) *codePtr->interpHandle; Tcl_HashEntry *hePtr = @@ -9111,7 +9115,7 @@ GetSrcInfoForPc( * in codePtr's code. */ ByteCode *codePtr, /* The bytecode sequence in which to look up * the command source for the pc. */ - size_t *lengthPtr, /* If non-NULL, the location where the length + Tcl_Size *lengthPtr, /* If non-NULL, the location where the length * of the command's source should be stored. * If NULL, no length is stored. */ const unsigned char **pcBeg,/* If non-NULL, the bytecode location @@ -9121,11 +9125,11 @@ GetSrcInfoForPc( * of the command containing the pc should * be stored. */ { - size_t pcOffset = (size_t)(pc - codePtr->codeStart); - size_t numCmds = codePtr->numCommands; + Tcl_Size pcOffset = pc - codePtr->codeStart; + Tcl_Size numCmds = codePtr->numCommands; unsigned char *codeDeltaNext, *codeLengthNext; unsigned char *srcDeltaNext, *srcLengthNext; - size_t codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; + Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i; int bestDist = INT_MAX; /* Distance of pc to best cmd's start pc. */ int bestSrcOffset = -1; /* Initialized to avoid compiler warning. */ int bestSrcLength = -1; /* Initialized to avoid compiler warning. */ @@ -9365,16 +9369,16 @@ TclExprFloatError( if ((errno == EDOM) || isnan(value)) { s = "domain error: argument not in valid range"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL); } else if ((errno == ERANGE) || isinf(value)) { if (value == 0.0) { s = "floating-point value too small to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL); } else { s = "floating-point value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL); } } else { diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index c1dbc88dee7a..ca4ff278a20f 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -221,7 +221,7 @@ TclFileMakeDirsCmd( { Tcl_Obj *errfile = NULL; int result, i; - size_t j, pobjc; + Tcl_Size j, pobjc; Tcl_Obj *split = NULL; Tcl_Obj *target = NULL; Tcl_StatBuf statBuf; @@ -426,7 +426,7 @@ TclFileDeleteCmd( if (result != TCL_OK) { if (errfile == NULL) { /* - * We try to accomodate poor error results from our Tcl_FS calls. + * We try to accommodate poor error results from our Tcl_FS calls. */ Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -874,7 +874,7 @@ FileBasename( TCL_UNUSED(Tcl_Interp *), /* Interp, for error return. */ Tcl_Obj *pathPtr) /* Path whose basename to extract. */ { - size_t objc; + Tcl_Size objc; Tcl_Obj *splitPtr; Tcl_Obj *resultPtr = NULL; @@ -947,7 +947,7 @@ TclFileAttrsCmd( const char *const *attributeStrings; const char **attributeStringsAllocated = NULL; Tcl_Obj *objStrings = NULL; - size_t numObjStrings = TCL_INDEX_NONE; + Tcl_Size numObjStrings = TCL_INDEX_NONE; Tcl_Obj *filePtr; if (objc < 2) { @@ -971,7 +971,7 @@ TclFileAttrsCmd( attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings); if (attributeStrings == NULL) { - size_t index; + Tcl_Size index; Tcl_Obj *objPtr; if (objStrings == NULL) { @@ -1042,7 +1042,7 @@ TclFileAttrsCmd( res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr); if (res == TCL_OK) { Tcl_Obj *objPtr = - Tcl_NewStringObj(attributeStrings[index], TCL_INDEX_NONE); + Tcl_NewStringObj(attributeStrings[index], -1); Tcl_ListObjAppendElement(interp, listPtr, objPtr); Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr); @@ -1212,7 +1212,7 @@ TclFileLinkCmd( if (contents == NULL) { /* * We handle three common error cases specially, and for all other - * errors, we use the standard posix error message. + * errors, we use the standard Posix error message. */ if (errno == EEXIST) { @@ -1381,7 +1381,7 @@ TclFileTemporaryCmd( TclNewObj(nameObj); } if (objc > 2) { - size_t length; + Tcl_Size length; Tcl_Obj *templateObj = objv[2]; const char *string = Tcl_GetStringFromObj(templateObj, &length); @@ -1492,7 +1492,7 @@ TclFileTemporaryCmd( return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return TCL_OK; } @@ -1533,7 +1533,7 @@ TclFileTempDirCmd( } if (objc > 1) { - int length; + Tcl_Size length; Tcl_Obj *templateObj = objv[1]; const char *string = Tcl_GetStringFromObj(templateObj, &length); const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 2581d3788cfc..c9148c1cce09 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -95,7 +95,7 @@ SetResultLength( * Results: * Returns the position in the path immediately after the root including * any trailing slashes. Appends a cleaned up version of the root to the - * Tcl_DString at the specified offest. + * Tcl_DString at the specified offset. * * Side effects: * Modifies the specified Tcl_DString. @@ -381,8 +381,8 @@ Tcl_GetPathType( Tcl_PathType TclpGetNativePathType( Tcl_Obj *pathPtr, /* Native path of interest */ - size_t *driveNameLengthPtr, /* Returns length of drive, if non-NULL and - * path was absolute */ + Tcl_Size *driveNameLengthPtr, /* Returns length of drive, if non-NULL and + * path was absolute */ Tcl_Obj **driveNameRef) { Tcl_PathType type = TCL_PATH_ABSOLUTE; @@ -465,7 +465,7 @@ TclpGetNativePathType( Tcl_Obj * TclpNativeSplitPath( Tcl_Obj *pathPtr, /* Path to split. */ - size_t *lenPtr) /* int to store number of path elements. */ + Tcl_Size *lenPtr) /* int to store number of path elements. */ { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ @@ -522,14 +522,14 @@ TclpNativeSplitPath( void Tcl_SplitPath( const char *path, /* Pointer to string containing a path. */ - size_t *argcPtr, /* Pointer to location to fill in with the + Tcl_Size *argcPtr, /* Pointer to location to fill in with the * number of elements in the path. */ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to path elements. */ { Tcl_Obj *resultPtr = NULL; /* Needed only to prevent gcc warnings. */ Tcl_Obj *tmpPtr, *eltPtr; - size_t i, size, len; + Tcl_Size i, size, len; char *p; const char *str; @@ -537,7 +537,7 @@ Tcl_SplitPath( * Perform the splitting, using objectified, vfs-aware code. */ - tmpPtr = Tcl_NewStringObj(path, TCL_INDEX_NONE); + tmpPtr = Tcl_NewStringObj(path, -1); Tcl_IncrRefCount(tmpPtr); resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr); Tcl_IncrRefCount(resultPtr); @@ -758,7 +758,7 @@ SplitWinPath( Tcl_Obj * Tcl_FSJoinToPath( Tcl_Obj *pathPtr, /* Valid path or NULL. */ - size_t objc, /* Number of array elements to join */ + Tcl_Size objc, /* Number of array elements to join */ Tcl_Obj *const objv[]) /* Path elements to join. */ { if (pathPtr == NULL) { @@ -774,7 +774,7 @@ Tcl_FSJoinToPath( pair[1] = objv[0]; return TclJoinPath(2, pair, 0); } else { - size_t elemc = objc + 1; + Tcl_Size elemc = objc + 1; Tcl_Obj *ret, **elemv = (Tcl_Obj**)Tcl_Alloc(elemc*sizeof(Tcl_Obj *)); elemv[0] = pathPtr; @@ -807,7 +807,7 @@ TclpNativeJoinPath( const char *joining) { int needsSep; - size_t length; + Tcl_Size length; char *dest; const char *p; const char *start; @@ -848,7 +848,7 @@ TclpNativeJoinPath( * Append the element, eliminating duplicate and trailing slashes. */ - Tcl_SetObjLength(prefix, length + (int) strlen(p)); + Tcl_SetObjLength(prefix, length + strlen(p)); dest = TclGetString(prefix) + length; for (; *p != '\0'; p++) { @@ -927,11 +927,11 @@ TclpNativeJoinPath( char * Tcl_JoinPath( - size_t argc, + Tcl_Size argc, const char *const *argv, Tcl_DString *resultPtr) /* Pointer to previously initialized DString */ { - size_t i, len; + Tcl_Size i, len; Tcl_Obj *listObj; Tcl_Obj *resultObj; const char *resultStr; @@ -943,7 +943,7 @@ Tcl_JoinPath( TclNewObj(listObj); for (i = 0; i < argc; i++) { Tcl_ListObjAppendElement(NULL, listObj, - Tcl_NewStringObj(argv[i], TCL_INDEX_NONE)); + Tcl_NewStringObj(argv[i], -1)); } /* @@ -1003,7 +1003,7 @@ Tcl_TranslateFileName( Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with * name. */ { - Tcl_Obj *path = Tcl_NewStringObj(name, TCL_INDEX_NONE); + Tcl_Obj *path = Tcl_NewStringObj(name, -1); Tcl_Obj *transPtr; Tcl_IncrRefCount(path); @@ -1118,7 +1118,7 @@ Tcl_GlobObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int i, globFlags, join, dir, result; - size_t length; + Tcl_Size length; char *string; const char *separators; Tcl_Obj *typePtr, *look; @@ -1171,7 +1171,7 @@ Tcl_GlobObjCmd( case GLOB_DIR: /* -dir */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing argument to \"-directory\"", TCL_INDEX_NONE)); + "missing argument to \"-directory\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -1199,7 +1199,7 @@ Tcl_GlobObjCmd( case GLOB_PATH: /* -path */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing argument to \"-path\"", TCL_INDEX_NONE)); + "missing argument to \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -1220,7 +1220,7 @@ Tcl_GlobObjCmd( case GLOB_TYPE: /* -types */ if (i == (objc-1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing argument to \"-types\"", TCL_INDEX_NONE)); + "missing argument to \"-types\"", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -1240,7 +1240,7 @@ Tcl_GlobObjCmd( if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-tails\" must be used with either " - "\"-directory\" or \"-path\"", TCL_INDEX_NONE)); + "\"-directory\" or \"-path\"", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BADOPTIONCOMBINATION", NULL); return TCL_ERROR; @@ -1257,7 +1257,7 @@ Tcl_GlobObjCmd( } if (dir == PATH_GENERAL) { - size_t pathlength; + Tcl_Size pathlength; const char *last; const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength); @@ -1291,7 +1291,7 @@ Tcl_GlobObjCmd( * in TclGlob requires a non-NULL pathOrDir. */ - Tcl_DStringAppend(&pref, first, TCL_INDEX_NONE); + Tcl_DStringAppend(&pref, first, -1); globFlags &= ~TCL_GLOBMODE_TAILS; pathOrDir = NULL; } else { @@ -1330,7 +1330,7 @@ Tcl_GlobObjCmd( } } if (*search != '\0') { - Tcl_DStringAppend(&prefix, search, TCL_INDEX_NONE); + Tcl_DStringAppend(&prefix, search, -1); } Tcl_DStringFree(&pref); } @@ -1358,7 +1358,7 @@ Tcl_GlobObjCmd( globTypes->macCreator = NULL; while (length-- > 0) { - size_t len; + Tcl_Size len; const char *str; Tcl_ListObjIndex(interp, typePtr, length, &look); @@ -1416,7 +1416,7 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; - size_t llen; + Tcl_Size llen; if ((TclListObjLengthM(NULL, look, &llen) == TCL_OK) && (llen == 3)) { @@ -1460,7 +1460,7 @@ Tcl_GlobObjCmd( badMacTypesArg: Tcl_SetObjResult(interp, Tcl_NewStringObj( "only one MacOS type or creator argument" - " to \"-types\" allowed", TCL_INDEX_NONE)); + " to \"-types\" allowed", -1)); result = TCL_ERROR; Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL); join = 0; @@ -1640,9 +1640,9 @@ TclGlob( Tcl_IncrRefCount(pathPrefix); } else if (pathPrefix == NULL && (tail[0] == '/' || (tail[0] == '\\' && tail[1] == '\\'))) { - size_t driveNameLen; + Tcl_Size driveNameLen; Tcl_Obj *driveName; - Tcl_Obj *temp = Tcl_NewStringObj(tail, TCL_INDEX_NONE); + Tcl_Obj *temp = Tcl_NewStringObj(tail, -1); Tcl_IncrRefCount(temp); switch (TclGetPathType(temp, NULL, &driveNameLen, &driveName)) { @@ -1708,7 +1708,7 @@ TclGlob( */ if (pathPrefix == NULL) { - size_t driveNameLen; + Tcl_Size driveNameLen; Tcl_Obj *driveName; if (TclFSNonnativePathType(tail, strlen(tail), NULL, &driveNameLen, &driveName) == TCL_PATH_ABSOLUTE) { @@ -1721,7 +1721,7 @@ TclGlob( * To process a [glob] invocation, this function may be called multiple * times. Each time, the previously discovered filenames are in the * interpreter result. We stash that away here so the result is free for - * error messsages. + * error messages. */ savedResultObj = Tcl_GetObjResult(interp); @@ -1793,9 +1793,9 @@ TclGlob( */ if (globFlags & TCL_GLOBMODE_TAILS) { - size_t objc, i; + Tcl_Size objc, i; Tcl_Obj **objv; - size_t prefixLen; + Tcl_Size prefixLen; const char *pre; /* @@ -1823,7 +1823,7 @@ TclGlob( TclListObjGetElementsM(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { - size_t len; + Tcl_Size len; const char *oldStr = Tcl_GetStringFromObj(objv[i], &len); Tcl_Obj *elem; @@ -2033,14 +2033,14 @@ DoGlob( break; } Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched open-brace in file name", TCL_INDEX_NONE)); + "unmatched open-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", NULL); return TCL_ERROR; } else if (*p == '}') { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched close-brace in file name", TCL_INDEX_NONE)); + "unmatched close-brace in file name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE", NULL); return TCL_ERROR; @@ -2072,7 +2072,7 @@ DoGlob( SkipToChar(&p, ','); Tcl_DStringSetLength(&newName, baseLength); Tcl_DStringAppend(&newName, element, p-element); - Tcl_DStringAppend(&newName, closeBrace+1, TCL_INDEX_NONE); + Tcl_DStringAppend(&newName, closeBrace+1, -1); result = DoGlob(interp, matchesObj, separators, pathPtr, flags, Tcl_DStringValue(&newName), types); if (result != TCL_OK) { @@ -2147,7 +2147,7 @@ DoGlob( pattern, &dirOnly); *p = save; if (result == TCL_OK) { - size_t i, subdirc, repair = TCL_INDEX_NONE; + Tcl_Size i, subdirc, repair = -1; Tcl_Obj **subdirv; result = TclListObjGetElementsM(interp, subdirsPtr, @@ -2158,14 +2158,14 @@ DoGlob( result = DoGlob(interp, matchesObj, separators, subdirv[i], 1, p+1, types); if (copy) { - size_t end; + Tcl_Size end; Tcl_DecrRefCount(subdirv[i]); subdirv[i] = copy; TclListObjLengthM(NULL, matchesObj, &end); - while (repair + 1 <= end) { + while (repair < end) { const char *bytes; - size_t numBytes; + Tcl_Size numBytes; Tcl_Obj *fixme, *newObj; Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme); @@ -2188,7 +2188,7 @@ DoGlob( */ if (*p == '\0') { - size_t length; + Tcl_Size length; Tcl_DString append; /* @@ -2252,7 +2252,7 @@ DoGlob( * The current prefix must end in a separator. */ - size_t len; + Tcl_Size len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { @@ -2289,7 +2289,7 @@ DoGlob( * This behaviour is not currently tested for in the test suite. */ - size_t len; + Tcl_Size len; const char *joined = Tcl_GetStringFromObj(joinedPtr,&len); if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) { diff --git a/generic/tclFileSystem.h b/generic/tclFileSystem.h index 852bbbd98789..e986d34390ea 100644 --- a/generic/tclFileSystem.h +++ b/generic/tclFileSystem.h @@ -48,13 +48,13 @@ MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem; MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, - size_t *driveNameLengthPtr); + Tcl_Size *driveNameLengthPtr); MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr, - size_t pathLen, const Tcl_Filesystem **filesystemPtrPtr, - size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef); + Tcl_Size pathLen, const Tcl_Filesystem **filesystemPtrPtr, + Tcl_Size *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, - size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef); + Tcl_Size *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE int TclFSEpochOk(size_t filesystemEpoch); MODULE_SCOPE int TclFSCwdIsNative(void); MODULE_SCOPE Tcl_Obj * TclWinVolumeRelativeNormalize(Tcl_Interp *interp, diff --git a/generic/tclHash.c b/generic/tclHash.c index 5cfc63c038fa..cb1e3c7c29d8 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -438,7 +438,7 @@ Tcl_DeleteHashTable( { Tcl_HashEntry *hPtr, *nextPtr; const Tcl_HashKeyType *typePtr; - size_t i; + Tcl_Size i; if (tablePtr->keyType == TCL_STRING_KEYS) { typePtr = &tclStringHashKeyType; @@ -587,7 +587,7 @@ Tcl_HashStats( Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - size_t i; + Tcl_Size i; TCL_HASH_TYPE count[NUM_COUNTERS], overflow, j; double average, tmp; Tcl_HashEntry *hPtr; @@ -623,18 +623,18 @@ Tcl_HashStats( */ result = (char *)Tcl_Alloc((NUM_COUNTERS * 60) + 300); - sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", + snprintf(result, 60, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i = 0; i < NUM_COUNTERS; i++) { - sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", + snprintf(p, 60, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", i, count[i]); p += strlen(p); } - sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n", + snprintf(p, 60, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n", NUM_COUNTERS, overflow); p += strlen(p); - sprintf(p, "average search distance for entry: %.1f", average); + snprintf(p, 60, "average search distance for entry: %.1f", average); return result; } diff --git a/generic/tclHistory.c b/generic/tclHistory.c index 8083b4df2cbd..dc5a67d77e55 100644 --- a/generic/tclHistory.c +++ b/generic/tclHistory.c @@ -69,7 +69,7 @@ Tcl_RecordAndEval( * Call Tcl_RecordAndEvalObj to do the actual work. */ - cmdPtr = Tcl_NewStringObj(cmd, TCL_INDEX_NONE); + cmdPtr = Tcl_NewStringObj(cmd, -1); Tcl_IncrRefCount(cmdPtr); result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags); diff --git a/generic/tclIO.c b/generic/tclIO.c index 5414e7346bf7..21aef59f10de 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -174,6 +174,8 @@ static int CloseWrite(Tcl_Interp *interp, Channel *chanPtr); static void CommonGetsCleanup(Channel *chanPtr); static int CopyData(CopyState *csPtr, int mask); static void DeleteTimerHandler(ChannelState *statePtr); +int Lossless(ChannelState *inStatePtr, + ChannelState *outStatePtr, long long toRead); static int MoveBytes(CopyState *csPtr); static void MBCallback(CopyState *csPtr, Tcl_Obj *errObj); @@ -196,7 +198,7 @@ static void DiscardOutputQueued(ChannelState *chanPtr); static Tcl_Size DoRead(Channel *chanPtr, char *dst, Tcl_Size bytesToRead, int allowShortReads); static Tcl_Size DoReadChars(Channel *chan, Tcl_Obj *objPtr, Tcl_Size toRead, - int appendFlag); + int allowShortReads, int appendFlag); static int FilterInputBytes(Channel *chanPtr, GetsState *statePtr); static int FlushChannel(Tcl_Interp *interp, Channel *chanPtr, @@ -221,8 +223,8 @@ static void StopCopy(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); -static int Write(Channel *chanPtr, const char *src, - int srcLen, Tcl_Encoding encoding); +static Tcl_Size Write(Channel *chanPtr, const char *src, + Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); @@ -338,6 +340,9 @@ static const Tcl_ObjType chanObjType = { TCL_OBJTYPE_V0 }; +#define GetIso88591() \ + (binaryEncoding ? Tcl_GetEncoding(NULL, "iso8859-1") : binaryEncoding) + #define ChanSetInternalRep(objPtr, resPtr) \ do { \ Tcl_ObjInternalRep ir; \ @@ -964,7 +969,7 @@ GetChannelTable( * * Side effects: * Deletes the hash table of channels. May close channels. May flush - * output on closed channels. Removes any channeEvent handlers that were + * output on closed channels. Removes any channelEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- @@ -997,7 +1002,7 @@ DeleteChannelTable( statePtr = chanPtr->state; /* - * Remove any fileevents registered in this interpreter. + * Remove any file events registered in this interpreter. */ for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL; @@ -1225,7 +1230,7 @@ Tcl_UnregisterChannel( if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" - " of channel", TCL_INDEX_NONE)); + " of channel", -1)); } return TCL_ERROR; } @@ -1416,7 +1421,7 @@ Tcl_GetChannel( * channel. */ const char *chanName, /* The name of the channel. */ int *modePtr) /* Where to store the mode in which the - * channel was opened? Will contain an ORed + * channel was opened? Will contain an OR'ed * combination of TCL_READABLE and * TCL_WRITABLE, if non-NULL. */ { @@ -1499,7 +1504,7 @@ TclGetChannelFromObj( Tcl_Obj *objPtr, Tcl_Channel *channelPtr, int *modePtr, /* Where to store the mode in which the - * channel was opened? Will contain an ORed + * channel was opened? Will contain an OR'ed * combination of TCL_READABLE and * TCL_WRITABLE, if non-NULL. */ TCL_UNUSED(int) /*flags*/) @@ -1670,18 +1675,15 @@ Tcl_CreateChannel( * interpretation that Tcl_Channels give to the "-encoding binary" option. */ - statePtr->encoding = NULL; name = Tcl_GetEncodingName(NULL); - if (strcmp(name, "binary") != 0) { - statePtr->encoding = Tcl_GetEncoding(NULL, name); - } + statePtr->encoding = Tcl_GetEncoding(NULL, name); statePtr->inputEncodingState = NULL; statePtr->inputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, TCL_ENCODING_PROFILE_DEFAULT); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, TCL_ENCODING_PROFILE_DEFAULT); /* @@ -1911,7 +1913,7 @@ Tcl_StackChannel( * impossible) we move the buffers from the common state structure into * the channel itself. We use the buffers in the channel below the new * transformation to hold the data. In the future this allows us to write - * transformations which pre-read data and push the unused part back when + * transformations which preread data and push the unused part back when * they are going away. */ @@ -2020,7 +2022,7 @@ ChannelFree( * A standard Tcl result. * * Side effects: - * If TCL_ERROR is returned, the posix error code will be set with + * If TCL_ERROR is returned, the Posix error code will be set with * Tcl_SetErrno. May leave a message in interp result as well. * *---------------------------------------------------------------------- @@ -2043,7 +2045,7 @@ Tcl_UnstackChannel( if (chanPtr->downChanPtr != NULL) { /* - * Instead of manipulating the per-thread / per-interp list/hashtable + * Instead of manipulating the per-thread / per-interp list/hash table * of registered channels we wind down the state of the * transformation, and then restore the state of underlying channel * into the old structure. @@ -2587,8 +2589,8 @@ RecycleBuffer( } /* - * Only save buffers which have the requested buffersize for the channel. - * This is to honor dynamic changes of the buffersize made by the user. + * Only save buffers which have the requested buffer size for the channel. + * This is to honor dynamic changes of the buffe rsize made by the user. */ if ((bufPtr->bufLength) != statePtr->bufSize + BUFFER_PADDING) { @@ -2701,7 +2703,7 @@ CheckForDeadChannel( Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unable to access channel: invalid channel", TCL_INDEX_NONE)); + "unable to access channel: invalid channel", -1)); } return 1; } @@ -2748,7 +2750,7 @@ FlushChannel( /* * Prevent writing on a dead channel -- a channel that has been closed but * not yet deallocated. This can occur if the exit handler for the channel - * deallocation runs before all channels are deregistered in all + * deallocation runs before all channels are unregistered in all * interpreters. */ @@ -2863,9 +2865,9 @@ FlushChannel( if (calledFromAsyncFlush) { /* * TIP #219, Tcl Channel Reflection API. - * When defering the error copy a message from the bypass into + * When deferring the error copy a message from the bypass into * the unreported area. Or discard it if the new error is to - * be ignored in favor of an earlier defered error. + * be ignored in favor of an earlier deferred error. */ Tcl_Obj *msg = statePtr->chanMsg; @@ -2899,7 +2901,7 @@ FlushChannel( if (interp != NULL && !TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } /* @@ -3209,8 +3211,8 @@ CloseChannel( * The channel to cut out of the list must not be referenced in any * interpreter. This is something this procedure cannot check (despite * the refcount) because the caller usually wants fiddle with the channel - * (like transfering it to a different thread) and thus keeps the - * refcount artifically high to prevent its destruction. + * (like transferring it to a different thread) and thus keeps the + * refcount artificially high to prevent its destruction. * *---------------------------------------------------------------------- */ @@ -3324,9 +3326,9 @@ Tcl_CutChannel( * NOTE: * The channel to splice into the list must not be referenced in any * interpreter. This is something this procedure cannot check (despite - * the refcount) because the caller usually wants figgle with the channel - * (like transfering it to a different thread) and thus keeps the - * refcount artifically high to prevent its destruction. + * the refcount) because the caller usually wants fiddle with the channel + * (like transferring it to a different thread) and thus keeps the + * refcount artificially high to prevent its destruction. * *---------------------------------------------------------------------- */ @@ -3462,7 +3464,7 @@ TclClose( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" - " of channel", TCL_INDEX_NONE)); + " of channel", -1)); } return TCL_ERROR; } @@ -3475,7 +3477,8 @@ TclClose( stickyError = 0; - if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL) + if (GotFlag(statePtr, TCL_WRITABLE) + && (statePtr->encoding != GetBinaryEncoding()) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) { int code = CheckChannelErrors(statePtr, TCL_WRITABLE); @@ -3565,7 +3568,7 @@ TclClose( Tcl_SetErrno(stickyError); if (interp != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } return TCL_ERROR; } @@ -3583,7 +3586,7 @@ TclClose( && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) { Tcl_SetErrno(result); Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), TCL_INDEX_NONE)); + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } if (result != 0) { return TCL_ERROR; @@ -3655,7 +3658,7 @@ Tcl_CloseEx( if (chanPtr != statePtr->topChanPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "half-close not applicable to stack of transformations", TCL_INDEX_NONE)); + "half-close not applicable to stack of transformations", -1)); return TCL_ERROR; } @@ -3688,7 +3691,7 @@ Tcl_CloseEx( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" - " of channel", TCL_INDEX_NONE)); + " of channel", -1)); } return TCL_ERROR; } @@ -3737,7 +3740,7 @@ Tcl_CloseEx( * * NOTE: * CloseWrite removes the channel as far as the user is concerned. - * However, the ooutput data structures may continue to exist for a while + * However, the output data structures may continue to exist for a while * longer if it has a background flush scheduled. The device itself is * eventually closed and the channel structures modified, in * CloseChannelPart, below. @@ -4179,7 +4182,7 @@ Tcl_WriteChars( /* * Inefficient way to convert UTF-8 to byte-array, but the code * parallels the way it is done for objects. Special case for 1-byte - * (used by eg [puts] for the \n) could be extended to more efficient + * (used by e.g. [puts] for the \n) could be extended to more efficient * translation of the src string. */ @@ -4237,6 +4240,7 @@ Tcl_WriteObj( Channel *chanPtr; ChannelState *statePtr; /* State info for channel */ const char *src; + Tcl_Size srcLen = 0; statePtr = ((Channel *) chan)->state; chanPtr = statePtr->topChanPtr; @@ -4244,38 +4248,21 @@ Tcl_WriteObj( if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) { return TCL_INDEX_NONE; } - - Tcl_Size srcLen; if (statePtr->encoding == NULL) { + Tcl_Size result; + src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen); if (src == NULL) { Tcl_SetErrno(EILSEQ); - return TCL_INDEX_NONE; + result = TCL_INDEX_NONE; + } else { + result = WriteBytes(chanPtr, src, srcLen); } + return result; } else { src = Tcl_GetStringFromObj(objPtr, &srcLen); + return WriteChars(chanPtr, src, srcLen); } - - size_t totalWritten = 0; - /* - * Note original code always called WriteChars even if srcLen 0 - * so we will too. - */ - do { - int chunkSize = srcLen > INT_MAX ? INT_MAX : srcLen; - int written; - if (statePtr->encoding == NULL) { - written = WriteBytes(chanPtr, src, chunkSize); - } else { - written = WriteChars(chanPtr, src, chunkSize); - } - if (written < 0) { - return TCL_INDEX_NONE; - } - totalWritten += written; - srcLen -= chunkSize; - } while (srcLen); - return totalWritten; } static void @@ -4346,17 +4333,18 @@ WillRead( *---------------------------------------------------------------------- */ -static int +static Tcl_Size Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ - int srcLen, /* Length of UTF-8 string in bytes. */ + Tcl_Size srcLen, /* Length of UTF-8 string in bytes. */ Tcl_Encoding encoding) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ char *nextNewLine = NULL; - int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0; + int endEncoding, needNlFlush = 0; + Tcl_Size saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; @@ -4369,7 +4357,6 @@ Write( */ endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); - if (GotFlag(statePtr, CHANNEL_LINEBUFFERED) || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) { nextNewLine = (char *)memchr(src, '\n', srcLen); @@ -4378,7 +4365,8 @@ Write( while (srcLen + saved + endEncoding > 0 && !encodingError) { ChannelBuffer *bufPtr; char *dst; - int result, srcRead, dstLen, dstWrote, srcLimit = srcLen; + int result, srcRead, dstLen, dstWrote; + Tcl_Size srcLimit = srcLen; if (nextNewLine) { srcLimit = nextNewLine - src; @@ -4422,16 +4410,14 @@ Write( * current output encoding and strict encoding is active. */ - if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) { - encodingError = 1; - result = TCL_OK; - } - - if ((result != TCL_OK) && (srcRead + dstWrote == 0)) { + if ( + (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) + || /* * We're reading from invalid/incomplete UTF-8. */ - + ((result != TCL_OK) && (srcRead + dstWrote == 0)) + ) { encodingError = 1; result = TCL_OK; } @@ -4491,7 +4477,7 @@ Write( * beginning of the next buffer. */ - saved = 1 + ~SpaceLeft(bufPtr); + saved = -SpaceLeft(bufPtr); memcpy(safe, dst + dstLen, saved); bufPtr->nextAdded = bufPtr->bufLength; } @@ -4508,7 +4494,7 @@ Write( /* * We just flushed. So if we have needNlFlush set to record that - * we need to flush because theres a (translated) newline in the + * we need to flush because there is a (translated) newline in the * buffer, that's likely not true any more. But there is a tricky * exception. If we have saved bytes that did not really get * flushed and those bytes came from a translation of a newline as @@ -4619,6 +4605,7 @@ Tcl_GetsObj( if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { UpdateInterest(chanPtr); + ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); Tcl_SetErrno(EILSEQ); return TCL_INDEX_NONE; } @@ -4648,10 +4635,10 @@ Tcl_GetsObj( * done on objPtr. */ - if ((statePtr->encoding == NULL) + if (statePtr->encoding == GetBinaryEncoding() && ((statePtr->inputTranslation == TCL_TRANSLATE_LF) || (statePtr->inputTranslation == TCL_TRANSLATE_CR)) - && Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) { + && Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL) != NULL) { return TclGetsObjBinary(chan, objPtr); } @@ -4678,15 +4665,6 @@ Tcl_GetsObj( oldRemoved = bufPtr->nextRemoved; } - /* - * If there is no encoding, use "iso8859-1" -- Tcl_GetsObj() doesn't - * produce ByteArray objects. - */ - - if (encoding == NULL) { - encoding = GetBinaryEncoding(); - } - /* * Object used by FilterInputBytes to keep track of how much data has been * consumed from the channel buffers. @@ -4762,7 +4740,7 @@ Tcl_GetsObj( /* * If a CR is at the end of the buffer, then check for a - * LF at the begining of the next buffer, unless EOF char + * LF at the beginning of the next buffer, unless EOF char * was found already. */ @@ -4884,11 +4862,11 @@ Tcl_GetsObj( && GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { /* Set eol to the position that caused the encoding error, and then - * coninue to gotEOL, which stores the data that was decoded + * continue to gotEOL, which stores the data that was decoded * without error to objPtr. This allows the caller to do something * useful with the data decoded so far, and also results in the * position of the file being the first byte that was not - * succesfully decoded, allowing further processing at exactly that + * successfully decoded, allowing further processing at exactly that * point, if desired. */ eol = dstEnd; @@ -5009,11 +4987,12 @@ Tcl_GetsObj( } UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); - if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && - (copiedTotal == 0 || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { + if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && gs.bytesWrote == 0) { + bufPtr->nextRemoved = oldRemoved; Tcl_SetErrno(EILSEQ); copiedTotal = -1; } + ResetFlag(statePtr, CHANNEL_ENCODING_ERROR); return copiedTotal; } @@ -5233,7 +5212,7 @@ TclGetsObjBinary( * XXX - unimplemented. */ - if (statePtr->encoding != NULL) { + if (statePtr->encoding != GetBinaryEncoding()) { } /* @@ -5475,6 +5454,8 @@ FilterInputBytes( if (result == TCL_CONVERT_UNKNOWN || result == TCL_CONVERT_SYNTAX) { SetFlag(statePtr, CHANNEL_ENCODING_ERROR); + ResetFlag(statePtr, CHANNEL_STICKY_EOF); + ResetFlag(statePtr, CHANNEL_EOF); result = TCL_OK; } @@ -5802,7 +5783,7 @@ Tcl_ReadRaw( /* * Go to the driver only if we got nothing from pushback. Have to do it - * this way to avoid EOF mis-timings when we consider the ability that EOF + * this way to avoid EOF mistimings when we consider the ability that EOF * may not be a permanent condition in the driver, and in that case we * have to synchronize. */ @@ -5901,7 +5882,7 @@ Tcl_ReadChars( return TCL_INDEX_NONE; } - return DoReadChars(chanPtr, objPtr, toRead, appendFlag); + return DoReadChars(chanPtr, objPtr, toRead, 0, appendFlag); } /* *--------------------------------------------------------------------------- @@ -5932,6 +5913,7 @@ DoReadChars( Tcl_Size toRead, /* Maximum number of characters to store, or * TCL_INDEX_NONE to read all available data (up to EOF or * when channel blocks). */ + int allowShortReads, /* Allow half-blocking (pipes,sockets) */ int appendFlag) /* If non-zero, data read from the channel * will be appended to the object. Otherwise, * the data will replace the existing contents @@ -5947,33 +5929,8 @@ DoReadChars( #define UTF_EXPANSION_FACTOR 1024 int factor = UTF_EXPANSION_FACTOR; - binaryMode = (encoding == NULL) - && (statePtr->inputTranslation == TCL_TRANSLATE_LF) - && (statePtr->inEofChar == '\0'); - - if (appendFlag) { - if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL))) { - binaryMode = 0; - } - } else { - if (binaryMode) { - Tcl_SetByteArrayLength(objPtr, 0); - } else { - Tcl_SetObjLength(objPtr, 0); - - /* - * We're going to access objPtr->bytes directly, so we must ensure - * that this is actually a string object (otherwise it might have - * been pure Unicode). - * - * Probably not needed anymore. - */ - - TclGetString(objPtr); - } - } - if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { + ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); /* TODO: We don't need this call? */ UpdateInterest(chanPtr); Tcl_SetErrno(EILSEQ); @@ -6017,6 +5974,22 @@ DoReadChars( chanPtr = statePtr->topChanPtr; TclChannelPreserve((Tcl_Channel)chanPtr); + binaryMode = (encoding == GetBinaryEncoding()) + && (statePtr->inputTranslation == TCL_TRANSLATE_LF) + && (statePtr->inEofChar == '\0'); + + if (appendFlag) { + if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL))) { + binaryMode = 0; + } + } else { + if (binaryMode) { + Tcl_SetByteArrayLength(objPtr, 0); + } else { + Tcl_SetObjLength(objPtr, 0); + } + } + /* * Must clear the BLOCKED|EOF flags here since we check before reading. */ @@ -6059,11 +6032,7 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && !GotFlag(statePtr, CHANNEL_STICKY_EOF) - && !GotFlag(statePtr, CHANNEL_NONBLOCKING)) { - /* Channel is blocking. Return an error so that callers - * like [read] can return an error. - */ - Tcl_SetErrno(EILSEQ); + && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) { goto finish; } } @@ -6072,8 +6041,8 @@ DoReadChars( if (GotFlag(statePtr, CHANNEL_EOF)) { break; } - if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED) - == (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) { + if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads) + && GotFlag(statePtr, CHANNEL_BLOCKED)) { break; } result = GetInput(chanPtr); @@ -6108,7 +6077,7 @@ DoReadChars( } /* - * Regenerate the top channel, in case it was changed due to + * Regenerate chanPtr in case it was changed due to * self-modifying reflected transforms. */ @@ -6130,8 +6099,15 @@ DoReadChars( assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); + + /* This must comes after UpdateInterest(), which may set errno */ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { + /* Channel either is blocking or is nonblocking with no data + * succesfully red before the error. Return an error so that callers + * like [read] can also return an error. + */ + ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); Tcl_SetErrno(EILSEQ); copied = -1; } @@ -6229,7 +6205,7 @@ ReadChars( * is larger than the number of characters * available in the first buffer, only the * characters from the first buffer are - * returned. The execption is when there is + * returned. The exception is when there is * not any complete character in the first * buffer. In that case, a recursive call * effectively obtains chars from the @@ -6240,8 +6216,7 @@ ReadChars( * UTF-8. On output, contains another guess * based on the data seen so far. */ { - Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding - : GetBinaryEncoding(); + Tcl_Encoding encoding = statePtr->encoding; Tcl_EncodingState savedState = statePtr->inputEncodingState; ChannelBuffer *bufPtr = statePtr->inQueueHead; int savedIEFlags = statePtr->inputEncodingFlags; @@ -6271,7 +6246,7 @@ ReadChars( (void) Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_AppendToObj(objPtr, NULL, dstLimit); if (toRead == srcLen) { - size_t size; + Tcl_Size size; dst = TclGetStringStorage(objPtr, &size) + numBytes; dstLimit = (size - numBytes) > INT_MAX ? INT_MAX : (size - numBytes); @@ -6324,7 +6299,12 @@ ReadChars( flags, &statePtr->inputEncodingState, dst, dstLimit, &srcRead, &dstDecoded, &numChars); - if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX) { + if (code == TCL_CONVERT_UNKNOWN || code == TCL_CONVERT_SYNTAX + || ( + code == TCL_CONVERT_MULTIBYTE + && GotFlag(statePtr, CHANNEL_EOF + )) + ) { SetFlag(statePtr, CHANNEL_ENCODING_ERROR); code = TCL_OK; } @@ -6567,7 +6547,7 @@ ReadChars( * precautions. */ - if (nextPtr->nextRemoved < (size_t)srcLen) { + if (nextPtr->nextRemoved < srcLen) { Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough"); } @@ -7075,7 +7055,7 @@ GetInput( bufPtr->nextPtr = NULL; toRead = SpaceLeft(bufPtr); - assert((size_t)toRead == statePtr->bufSize); + assert((Tcl_Size)toRead == statePtr->bufSize); if (statePtr->inQueueTail == NULL) { statePtr->inQueueHead = bufPtr; @@ -7412,7 +7392,7 @@ Tcl_TruncateChannel( /* * Seek first to force a total flush of all pending buffers and ditch any - * pre-read input data. + * preread input data. */ WillWrite(chanPtr); @@ -7472,7 +7452,7 @@ CheckChannelErrors( /* * TIP #219, Tcl Channel Reflection API. - * Move a defered error message back into the channel bypass. + * Move a deferred error message back into the channel bypass. */ if (statePtr->chanMsg != NULL) { @@ -7610,7 +7590,7 @@ Tcl_InputBuffered( } /* - * Don't forget the bytes in the topmost pushback area. + * Remember the bytes in the topmost pushback area. */ for (bufPtr = statePtr->topChanPtr->inQueueHead; bufPtr != NULL; @@ -7726,7 +7706,7 @@ Tcl_SetChannelBufferSize( * Clip the buffer size to force it into the [1,1M] range */ - if (sz < 1 || sz > (TCL_INDEX_NONE>>1)) { + if (sz < 1) { sz = 1; } else if (sz > MAX_CHANNEL_BUFFER_SIZE) { sz = MAX_CHANNEL_BUFFER_SIZE; @@ -7800,7 +7780,7 @@ Tcl_GetChannelBufferSize( * Side effects: * An error message is generated in interp's result object to indicate - * that a command was invoked with the a bad option. The message has the + * that a command was invoked with a bad option. The message has the * form: * bad option "blah": should be one of * <...generic options...>+<...specific options...> @@ -7829,10 +7809,10 @@ Tcl_BadChannelOption( Tcl_Obj *errObj; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, genericopt, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { TclDStringAppendLiteral(&ds, " "); - Tcl_DStringAppend(&ds, optionList, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv) != TCL_OK) { @@ -7882,7 +7862,7 @@ Tcl_GetChannelOption( Tcl_DString *dsPtr) /* Where to store value(s). */ { size_t len; /* Length of optionName string. */ - char optionVal[128]; /* Buffer for sprintf. */ + char optionVal[128]; /* Buffer for snprintf. */ Channel *chanPtr = (Channel *) chan; ChannelState *statePtr = chanPtr->state; /* State info for channel */ @@ -7967,12 +7947,8 @@ Tcl_GetChannelOption( if (len == 0) { Tcl_DStringAppendElement(dsPtr, "-encoding"); } - if (statePtr->encoding == NULL) { - Tcl_DStringAppendElement(dsPtr, "binary"); - } else { - Tcl_DStringAppendElement(dsPtr, - Tcl_GetEncodingName(statePtr->encoding)); - } + Tcl_DStringAppendElement(dsPtr, + Tcl_GetEncodingName(statePtr->encoding)); if (len > 0) { return TCL_OK; } @@ -7983,10 +7959,10 @@ Tcl_GetChannelOption( Tcl_DStringAppendElement(dsPtr, "-eofchar"); } if ((flags & TCL_READABLE) && (statePtr->inEofChar != 0)) { - sprintf(buf, "%c", statePtr->inEofChar); + snprintf(buf, sizeof(buf), "%c", statePtr->inEofChar); } if (len > 0) { - Tcl_DStringAppend(dsPtr, buf, TCL_INDEX_NONE); + Tcl_DStringAppend(dsPtr, buf, -1); return TCL_OK; } Tcl_DStringAppendElement(dsPtr, buf); @@ -7998,7 +7974,7 @@ Tcl_GetChannelOption( Tcl_DStringAppendElement(dsPtr, "-profile"); } /* Note currently input and output profiles are same */ - profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags); + profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags); profileName = TclEncodingProfileIdToName(interp, profile); if (profileName == NULL) { return TCL_ERROR; @@ -8114,7 +8090,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to set channel options: background copy in" - " progress", TCL_INDEX_NONE)); + " progress", -1)); } return TCL_ERROR; } @@ -8165,7 +8141,7 @@ Tcl_SetChannelOption( } else if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -buffering: must be one of" - " full, line, or none", TCL_INDEX_NONE)); + " full, line, or none", -1)); return TCL_ERROR; } return TCL_OK; @@ -8192,7 +8168,13 @@ Tcl_SetChannelOption( int profile; if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) { - encoding = NULL; + encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else { encoding = Tcl_GetEncoding(interp, newValue); if (encoding == NULL) { @@ -8205,7 +8187,7 @@ Tcl_SetChannelOption( * iso2022, the terminated escape sequence must write to the buffer. */ - if ((statePtr->encoding != NULL) + if ((statePtr->encoding != GetBinaryEncoding()) && !(statePtr->outputEncodingFlags & TCL_ENCODING_START) && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) { statePtr->outputEncodingFlags |= TCL_ENCODING_END; @@ -8214,12 +8196,12 @@ Tcl_SetChannelOption( Tcl_FreeEncoding(statePtr->encoding); statePtr->encoding = encoding; statePtr->inputEncodingState = NULL; - profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags); + profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags); statePtr->inputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile); statePtr->outputEncodingState = NULL; statePtr->outputEncodingFlags = TCL_ENCODING_START; - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */ + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */ ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR); UpdateInterest(chanPtr); return TCL_OK; @@ -8236,7 +8218,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -eofchar: must be non-NUL ASCII" - " character", TCL_INDEX_NONE)); + " character", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; @@ -8262,8 +8244,8 @@ Tcl_SetChannelOption( if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) { return TCL_ERROR; } - CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile); - CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile); + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR); return TCL_OK; } else if (HaveOpt(1, "-translation")) { @@ -8283,7 +8265,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be a one or two" - " element list", TCL_INDEX_NONE)); + " element list", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; @@ -8300,7 +8282,13 @@ Tcl_SetChannelOption( translation = TCL_TRANSLATE_LF; statePtr->inEofChar = 0; Tcl_FreeEncoding(statePtr->encoding); - statePtr->encoding = NULL; + statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(readMode, "lf") == 0) { translation = TCL_TRANSLATE_LF; } else if (strcmp(readMode, "cr") == 0) { @@ -8313,7 +8301,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE)); + "auto, binary, cr, lf, crlf, or platform", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; @@ -8349,7 +8337,13 @@ Tcl_SetChannelOption( } else if (strcmp(writeMode, "binary") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; Tcl_FreeEncoding(statePtr->encoding); - statePtr->encoding = NULL; + statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1"); + ENCODING_PROFILE_SET(statePtr->inputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); + ENCODING_PROFILE_SET(statePtr->outputEncodingFlags + ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags) + |TCL_ENCODING_PROFILE_STRICT); } else if (strcmp(writeMode, "lf") == 0) { statePtr->outputTranslation = TCL_TRANSLATE_LF; } else if (strcmp(writeMode, "cr") == 0) { @@ -8362,7 +8356,7 @@ Tcl_SetChannelOption( if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " - "auto, binary, cr, lf, crlf, or platform", TCL_INDEX_NONE)); + "auto, binary, cr, lf, crlf, or platform", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; @@ -9365,23 +9359,7 @@ TclCopyChannel( ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED); SetFlag(outStatePtr, CHANNEL_UNBUFFERED); - /* - * Test for conditions where we know we can just move bytes from input - * channel to output channel with no transformation or even examination - * of the bytes themselves. - */ - - /* - * TODO - should really only allow lossless profiles. Below reflects - * Tcl 8.7 alphas prior to encoding profiles - */ - - moveBytes = inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ - && inStatePtr->inputTranslation == TCL_TRANSLATE_LF - && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && inStatePtr->encoding == outStatePtr->encoding - && CHANNEL_PROFILE_GET(inStatePtr->flags) != TCL_ENCODING_PROFILE_STRICT - && CHANNEL_PROFILE_GET(outStatePtr->flags) == TCL_ENCODING_PROFILE_TCL8; + moveBytes = Lossless(inStatePtr, outStatePtr, toRead); /* * Allocate a new CopyState to maintain info about the current copy in @@ -9686,10 +9664,9 @@ CopyData( int result = TCL_OK; Tcl_Size sizeb; Tcl_WideInt total; - Tcl_WideInt size; /* TODO - be careful if total and size are made unsigned */ + Tcl_WideInt size; const char *buffer; - int inBinary, outBinary, sameEncoding; - /* Encoding control */ + int moveBytes; int underflow; /* Input underflow */ inChan = (Tcl_Channel) csPtr->readPtr; @@ -9707,13 +9684,9 @@ CopyData( * the bottom of the stack. */ - inBinary = (inStatePtr->encoding == NULL); - outBinary = (outStatePtr->encoding == NULL); - sameEncoding = inStatePtr->encoding == outStatePtr->encoding - && CHANNEL_PROFILE_GET(inStatePtr->flags) != TCL_ENCODING_PROFILE_STRICT - && CHANNEL_PROFILE_GET(outStatePtr->flags) == TCL_ENCODING_PROFILE_TCL8; + moveBytes = Lossless(inStatePtr, outStatePtr, csPtr->toRead); - if (!(inBinary || sameEncoding)) { + if (!moveBytes) { TclNewObj(bufObj); Tcl_IncrRefCount(bufObj); } @@ -9754,7 +9727,7 @@ CopyData( underflow = 1; } else { /* - * Read up to bufSize bytes. + * Read up to bufSize characters. */ if ((csPtr->toRead == (Tcl_WideInt) -1) @@ -9764,14 +9737,15 @@ CopyData( sizeb = csPtr->toRead; } - if (inBinary || sameEncoding) { + if (moveBytes) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, - 0 /* No append */); + !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) + ,0 /* No append */); } - underflow = (size >= 0) && ((size_t)size < sizeb); /* Input underflow */ + underflow = (size >= 0) && (size < sizeb); /* Input underflow */ } if (size < 0) { @@ -9830,32 +9804,27 @@ CopyData( * Now write the buffer out. */ - if (inBinary || sameEncoding) { + if (moveBytes) { buffer = csPtr->buffer; - sizeb = size; + sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, size); } else { buffer = Tcl_GetStringFromObj(bufObj, &sizeb); - } - - if (outBinary || sameEncoding) { - sizeb = WriteBytes(outStatePtr->topChanPtr, buffer, sizeb); - } else { sizeb = WriteChars(outStatePtr->topChanPtr, buffer, sizeb); } /* * [Bug 2895565]. At this point 'size' still contains the number of - * bytes or characters which have been read. We keep this to later to + * characters which have been read. We keep this to later to * update the totals and toRead information, see marker (UP) below. We * must not overwrite it with 'sizeb', which is the number of written - * bytes or characters, and both EOL translation and encoding + * characters, and both EOL translation and encoding * conversion may have changed this number unpredictably in relation * to 'size' (It can be smaller or larger, in the latter case able to * drive toRead below -1, causing infinite looping). Completely * unsuitable for updating totals and toRead. */ - if (sizeb == TCL_INDEX_NONE) { + if (sizeb < 0) { writeError: if (interp) { TclNewObj(errObj); @@ -9875,10 +9844,10 @@ CopyData( } /* - * Update the current byte count. Do it now so the count is valid + * Update the current character count. Do it now so the count is valid * before a return or break takes us out of the loop. The invariant at * the top of the loop should be that csPtr->toRead holds the number - * of bytes left to copy. + * of characters left to copy. */ if (csPtr->toRead != -1) { @@ -9945,8 +9914,8 @@ CopyData( } /* - * Make the callback or return the number of bytes transferred. The local - * total is used because StopCopy frees csPtr. + * Make the callback or return the number of characters transferred. The + * local total is used because StopCopy frees csPtr. */ total = csPtr->total; @@ -10087,7 +10056,7 @@ DoRead( while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ - ((size_t)BytesLeft(bufPtr) < bytesToRead))) { + ((Tcl_Size) BytesLeft(bufPtr) < bytesToRead))) { /* Not enough bytes in it yet * to fill the dst */ int code; @@ -10266,6 +10235,46 @@ CopyEventProc( (void) CopyData((CopyState *)clientData, mask); } +/* + *---------------------------------------------------------------------- + * + * Lossless -- + * + * Determines whether copying characters between two channel states would + * be lossless, i.e. whether one byte corresponds to one character, every + * character appears in the Unicode character set, there are no + * translations to be performed, and no inline signals to respond to. + * + * Result: + * True if copying would be lossless. + * + *---------------------------------------------------------------------- + */ +int +Lossless( + ChannelState *inStatePtr, + ChannelState *outStatePtr, + long long toRead) +{ + return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ + && inStatePtr->inputTranslation == TCL_TRANSLATE_LF + && outStatePtr->outputTranslation == TCL_TRANSLATE_LF + && ( + ( + inStatePtr->encoding == GetBinaryEncoding() + && + outStatePtr->encoding == GetBinaryEncoding() + ) + || + ( + toRead == -1 + && inStatePtr->encoding == outStatePtr->encoding + && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 + && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 + ) + ); +} + /* *---------------------------------------------------------------------- * @@ -10522,7 +10531,7 @@ Tcl_GetChannelNamesEx( && (pattern[2] == 'd'))) { if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL) && (Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(pattern, TCL_INDEX_NONE)) != TCL_OK)) { + Tcl_NewStringObj(pattern, -1)) != TCL_OK)) { goto error; } goto done; @@ -10549,7 +10558,7 @@ Tcl_GetChannelNamesEx( if (((pattern == NULL) || Tcl_StringMatch(name, pattern)) && (Tcl_ListObjAppendElement(interp, resultPtr, - Tcl_NewStringObj(name, TCL_INDEX_NONE)) != TCL_OK)) { + Tcl_NewStringObj(name, -1)) != TCL_OK)) { error: TclDecrRefCount(resultPtr); return TCL_ERROR; @@ -11134,7 +11143,7 @@ FixLevelCode( * Syntax = (option value)... ?message? * * Bad message syntax causes a panic, because the other side uses - * Tcl_GetReturnOptions and list construction functions to marshall the + * Tcl_GetReturnOptions and list construction functions to marshal the * information. Hence an error means that we've got serious breakage. */ @@ -11203,8 +11212,8 @@ FixLevelCode( lvn = (Tcl_Obj **)Tcl_Alloc(lcn * sizeof(Tcl_Obj *)); /* - * New level/code information is spliced into the first occurence of - * -level, -code, further occurences are ignored. The options cannot be + * New level/code information is spliced into the first occurrence of + * -level, -code, further occurrences are ignored. The options cannot be * not present, we would not come here. Options which are ok are simply * copied over. */ diff --git a/generic/tclIO.h b/generic/tclIO.h index 67807c0cc43a..145296aafdc2 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -36,16 +36,16 @@ */ typedef struct ChannelBuffer { - size_t refCount; /* Current uses count */ - size_t nextAdded; /* The next position into which a character + Tcl_Size refCount; /* Current uses count */ + Tcl_Size nextAdded; /* The next position into which a character * will be put in the buffer. */ - size_t nextRemoved; /* Position of next byte to be removed from + Tcl_Size nextRemoved; /* Position of next byte to be removed from * the buffer. */ - size_t bufLength; /* How big is the buffer? */ + Tcl_Size bufLength; /* How big is the buffer? */ struct ChannelBuffer *nextPtr; /* Next buffer in chain. */ char buf[TCLFLEXARRAY]; /* Placeholder for real buffer. The real - * buffer occuppies this space + bufSize-1 + * buffer occupies this space + bufSize-1 * bytes. This must be the last field in the * structure. */ } ChannelBuffer; @@ -113,7 +113,7 @@ typedef struct Channel { ChannelBuffer *inQueueHead; /* Points at first buffer in input queue. */ ChannelBuffer *inQueueTail; /* Points at last buffer in input queue. */ - size_t refCount; + Tcl_Size refCount; } Channel; /* @@ -129,7 +129,7 @@ typedef struct ChannelState { char *channelName; /* The name of the channel instance in Tcl * commands. Storage is owned by the generic * IO code, is dynamically allocated. */ - int flags; /* ORed combination of the flags defined + int flags; /* OR'ed combination of the flags defined * below. */ Tcl_Encoding encoding; /* Encoding to apply when reading or writing * data on this channel. NULL means no @@ -165,7 +165,7 @@ typedef struct ChannelState { int unreportedError; /* Non-zero if an error report was deferred * because it happened in the background. The * value is the POSIX error code. */ - size_t refCount; /* How many interpreters hold references to + Tcl_Size refCount; /* How many interpreters hold references to * this IO channel? */ struct CloseCallback *closeCbPtr; /* Callbacks registered to be called when the @@ -188,7 +188,7 @@ typedef struct ChannelState { EventScriptRecord *scriptRecordPtr; /* Chain of all scripts registered for event * handlers ("fileevent") on this channel. */ - size_t bufSize; /* What size buffers to allocate? */ + Tcl_Size bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of the right channel when the timer is @@ -211,7 +211,7 @@ typedef struct ChannelState { * TIP #219 ... Info for the I/O system ... * Error message set by channel drivers, for the propagation of arbitrary * Tcl errors. This information, if present (chanMsg not NULL), takes - * precedence over a posix error code returned by a channel operation. + * precedence over a Posix error code returned by a channel operation. */ Tcl_Obj* chanMsg; @@ -226,7 +226,7 @@ typedef struct ChannelState { } ChannelState; /* - * Values for the flags field in Channel. Any ORed combination of the + * Values for the flags field in Channel. Any OR'ed combination of the * following flags can be stored in the field. These flags record various * options and state bits about the channel. In addition to the flags below, * the channel can also have TCL_READABLE (1<<1) and TCL_WRITABLE (1<<2) set. @@ -288,13 +288,6 @@ typedef struct ChannelState { #define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed. * No further Tcl-level write IO on * the channel is allowed. */ -#define CHANNEL_PROFILE_MASK 0xFF000000 -#define CHANNEL_PROFILE_GET(flags_) ((flags_) & CHANNEL_PROFILE_MASK) -#define CHANNEL_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~CHANNEL_PROFILE_MASK; \ - (flags_) |= profile_; \ - } while (0) /* * The length of time to wait between synthetic timer events. Must be zero or diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index cdb8083932f4..93c50eceb6ec 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -107,7 +107,7 @@ Tcl_PutsObjCmd( Tcl_Obj *string; /* String to write. */ Tcl_Obj *chanObjPtr = NULL; /* channel object. */ int newline; /* Add a newline at end? */ - size_t result; /* Result of puts operation. */ + Tcl_Size result; /* Result of puts operation. */ int mode; /* Mode in which channel is opened. */ switch (objc) { @@ -281,7 +281,7 @@ Tcl_GetsObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Channel chan; /* The channel to read from. */ - size_t lineLen; /* Length of line just read. */ + Tcl_Size lineLen; /* Length of line just read. */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *linePtr, *chanObjPtr; int code = TCL_OK; @@ -369,7 +369,7 @@ Tcl_ReadObjCmd( Tcl_Channel chan; /* The channel to read from. */ int newline, i; /* Discard newline at end? */ Tcl_WideInt toRead; /* How many bytes to read? */ - size_t charactersRead; /* How many characters were read? */ + Tcl_Size charactersRead; /* How many characters were read? */ int mode; /* Mode in which channel is opened. */ Tcl_Obj *resultPtr, *chanObjPtr; @@ -430,10 +430,10 @@ Tcl_ReadObjCmd( } TclNewObj(resultPtr); - Tcl_IncrRefCount(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); if (charactersRead == TCL_IO_FAILURE) { + Tcl_DecrRefCount(resultPtr); /* * TIP #219. * Capture error messages put by the driver into the bypass area and @@ -447,7 +447,6 @@ Tcl_ReadObjCmd( TclGetString(chanObjPtr), Tcl_PosixError(interp))); } TclChannelRelease(chan); - Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } @@ -457,7 +456,7 @@ Tcl_ReadObjCmd( if ((charactersRead > 0) && (newline != 0)) { const char *result; - size_t length; + Tcl_Size length; result = Tcl_GetStringFromObj(resultPtr, &length); if (result[length - 1] == '\n') { @@ -466,7 +465,6 @@ Tcl_ReadObjCmd( } Tcl_SetObjResult(interp, resultPtr); TclChannelRelease(chan); - Tcl_DecrRefCount(resultPtr); return TCL_OK; } @@ -700,7 +698,7 @@ Tcl_CloseObjCmd( Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); const char *string; - size_t len; + Tcl_Size len; if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); @@ -860,7 +858,7 @@ Tcl_ExecObjCmd( const char *string; Tcl_Channel chan; int argc, background, i, index, keepNewline, result, skip, ignoreStderr; - size_t length; + Tcl_Size length; static const char *const options[] = { "-ignorestderr", "-keepnewline", "--", NULL }; @@ -1009,7 +1007,7 @@ Tcl_ExecObjCmd( * * Side effects: * Sets interp's result to boolean true or false depending on whether the - * preceeding input operation on the channel would have blocked. + * preceding input operation on the channel would have blocked. * *--------------------------------------------------------------------------- */ @@ -1083,7 +1081,7 @@ Tcl_OpenObjCmd( if (objc == 4) { const char *permString = TclGetString(objv[3]); int code = TCL_ERROR; - int scanned = TclParseAllWhiteSpace(permString, TCL_INDEX_NONE); + int scanned = TclParseAllWhiteSpace(permString, -1); /* * Support legacy octal numbers. @@ -1121,7 +1119,7 @@ Tcl_OpenObjCmd( chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot); } else { int mode, seekFlag, binary; - size_t cmdObjc; + Tcl_Size cmdObjc; const char **cmdArgv; if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) { diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index 532adbd55614..98a1dd334496 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -258,7 +258,7 @@ TclChannelTransform( Channel *chanPtr; /* The actual channel. */ ChannelState *statePtr; /* State info for channel. */ int mode; /* Read/write mode of the channel. */ - size_t objc; + Tcl_Size objc; TransformChannelData *dataPtr; Tcl_DString ds; @@ -268,7 +268,7 @@ TclChannelTransform( if (TCL_OK != TclListObjLengthM(interp, cmdObjPtr, &objc)) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("-command value is not a list", TCL_INDEX_NONE)); + Tcl_NewStringObj("-command value is not a list", -1)); return TCL_ERROR; } @@ -375,7 +375,7 @@ ExecuteCallback( * interpreters. */ { Tcl_Obj *resObj; /* See below, switch (transmit). */ - size_t resLen = 0; + Tcl_Size resLen = 0; unsigned char *resBuf; Tcl_InterpState state = NULL; int res = TCL_OK; @@ -397,11 +397,11 @@ ExecuteCallback( } Tcl_IncrRefCount(command); - Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, TCL_INDEX_NONE)); + Tcl_ListObjAppendElement(NULL, command, Tcl_NewStringObj((char *) op, -1)); /* * Use a byte-array to prevent the misinterpretation of binary data coming - * through as UTF while at the tcl level. + * through as Utf while at the tcl level. */ Tcl_ListObjAppendElement(NULL, command, Tcl_NewByteArrayObj(buf, bufLen)); @@ -409,7 +409,7 @@ ExecuteCallback( /* * Step 2, execute the command at the global level of the interpreter used * to create the transformation. Destroy the command afterward. If an - * error occured and the current interpreter is defined and not equal to + * error occurred and the current interpreter is defined and not equal to * the interpreter for the callback, then copy the error message into * current interpreter. Don't copy if in preservation mode. */ @@ -573,7 +573,7 @@ TransformCloseProc( * Now flush data waiting in internal buffers to output and input. The * input must be done despite the fact that there is no real receiver for * it anymore. But the scripts might have sideeffects other parts of the - * system rely on (f.e. signaling the close to interested parties). + * system rely on (f.e. signalling the close to interested parties). */ PreserveData(dataPtr); @@ -1015,7 +1015,7 @@ TransformWatchProc( Tcl_Channel downChan; /* - * The caller expressed interest in events occuring for this channel. We + * The caller expressed interest in events occurring for this channel. We * are forwarding the call to the underlying channel now. */ @@ -1122,12 +1122,12 @@ static int TransformNotifyProc( void *clientData, /* The state of the notified * transformation. */ - int mask) /* The mask of occuring events. */ + int mask) /* The mask of occurring events. */ { TransformChannelData *dataPtr = (TransformChannelData *)clientData; /* - * An event occured in the underlying channel. This transformation doesn't + * An event occurred in the underlying channel. This transformation doesn't * process such events thus returns the incoming mask unchanged. */ @@ -1217,7 +1217,7 @@ ResultClear( * ResultInit -- * * Initializes the specified buffer structure. The structure will contain - * valid information for an emtpy buffer. + * valid information for an empty buffer. * * Side effects: * See above. diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index ba2d2cb8bbf0..f2138c4a4fc9 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -10,7 +10,7 @@ * * See TIP #219 for the specification of this functionality. * - * Copyright © 2004-2005 ActiveState, a divison of Sophos + * Copyright © 2004-2005 ActiveState, a division of Sophos * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -131,7 +131,7 @@ typedef struct { * data in buffers is flushed out through the generation of fake file * events. * - * See 'rechan', 'memchan', etc. + * See 'refchan', 'memchan', etc. * * A timer is used here as well in order to ensure at least on pass through * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and @@ -140,7 +140,7 @@ typedef struct { } ReflectedChannel; /* - * Structure of the table maping from channel handles to reflected + * Structure of the table mapping from channel handles to reflected * channels. Each interpreter which has the handler command for one or more * reflected channels records them in such a table, so that 'chan postevent' * is able to find them even if the actual channel was moved to a different @@ -266,13 +266,13 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - size_t toRead; /* I: #bytes to read, + Tcl_Size toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ const char *buf; /* I: Where the bytes to write come from */ - int toWrite; /* I: #bytes to write, + Tcl_Size toWrite; /* I: #bytes to write, * O: #bytes actually written */ }; struct ForwardParamSeek { @@ -513,7 +513,7 @@ TclChanCreateObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - size_t listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -549,7 +549,7 @@ TclChanCreateObjCmd( /* * First argument is a list of modes. Allowed entries are "read", "write". - * Expect at least one list element. Abbreviations are ok. + * Empty list is uncommon, but allowed. Abbreviations are ok. */ modeObj = objv[MODE]; @@ -887,8 +887,8 @@ TclChanPostEventObjCmd( * handles of reflected channels, and only of such whose handler is * defined in this interpreter. * - * We keep the old checks for both, for paranioa, but abort now instead of - * throwing errors, as failure now means that our internal datastructures + * We keep the old checks for both, for paranoia, but abort now instead of + * throwing errors, as failure now means that our internal data structures * have gone seriously haywire. */ @@ -922,6 +922,11 @@ TclChanPostEventObjCmd( if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) { return TCL_ERROR; } + if (events == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("bad event list: is empty", -1)); + return TCL_ERROR; + } /* * Check that the channel is actually interested in the provided events. @@ -1047,10 +1052,10 @@ UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { - size_t lc; + Tcl_Size lc; Tcl_Obj **lv; int explicitResult; - size_t numOptions; + Tcl_Size numOptions; /* * Process the caught message. @@ -1058,7 +1063,7 @@ UnmarshallErrorResult( * Syntax = (option value)... ?message? * * Bad syntax causes a panic. This is OK because the other side uses - * Tcl_GetReturnOptions and list construction functions to marshall the + * Tcl_GetReturnOptions and list construction functions to marshal the * information; if we panic here, something has gone badly wrong already. */ @@ -1149,7 +1154,7 @@ TclChanCaughtErrorBypass( * driver-specific instance data. * * Results: - * A posix error. + * A Posix error. * * Side effects: * Releases memory. Arbitrary, as it calls upon a script. @@ -1326,7 +1331,7 @@ ReflectInput( { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *toReadObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ Tcl_Obj *resObj; /* Result data for 'read' */ @@ -1388,14 +1393,14 @@ ReflectInput( if (bytev == NULL) { SetChannelErrorStr(rcPtr->chan, msg_read_nonbyte); goto invalid; - } else if ((size_t)toRead < bytec) { + } else if (toRead < bytec) { SetChannelErrorStr(rcPtr->chan, msg_read_toomuch); goto invalid; } *errorCodePtr = EOK; - if (bytec + 1 > 1) { + if (bytec > 0) { memcpy(buf, bytev, bytec); } @@ -1713,7 +1718,7 @@ ReflectWatch( * is required of it. * * Results: - * A posix error number. + * A Posix error number. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. @@ -1912,7 +1917,7 @@ ReflectGetOption( ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; Tcl_Obj *optionObj; Tcl_Obj *resObj; /* Result data for 'configure' */ - size_t listc; + Tcl_Size listc; int result = TCL_OK; Tcl_Obj **listv; MethodName method; @@ -2006,11 +2011,11 @@ ReflectGetOption( Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " - "elements, got %" TCL_Z_MODIFIER "u element%s instead", listc, + "elements, got %" TCL_SIZE_MODIFIER "u element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { - size_t len; + Tcl_Size len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { @@ -2111,10 +2116,10 @@ ReflectTruncate( * EncodeEventMask -- * * This function takes a list of event items and constructs the - * equivalent internal bitmask. The list must contain at least one - * element. Elements are "read", "write", or any unique abbreviation of - * them. Note that the bitmask is not changed if problems are - * encountered. + * equivalent internal bitmask. The list may be empty but will usually + * contain at least one element. Valid elements are "read", "write", or + * any unique abbreviation of them. Note that the bitmask is not changed + * if problems are encountered. * * Results: * A standard Tcl error code. A bitmask where TCL_READABLE and/or @@ -2135,7 +2140,7 @@ EncodeEventMask( int *mask) { int events; /* Mask of events to post */ - size_t listc; /* #elements in eventspec list */ + Tcl_Size listc; /* #elements in eventspec list */ Tcl_Obj **listv; /* Elements of eventspec list */ int evIndex; /* Id of event for an element of the eventspec * list. */ @@ -2144,12 +2149,6 @@ EncodeEventMask( return TCL_ERROR; } - if (listc < 1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "bad %s list: is empty", objName)); - return TCL_ERROR; - } - events = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions, @@ -2286,7 +2285,7 @@ NewReflectedChannel( * refcount of the returned object is -- zero --. * * Side effects: - * May allocate memory. Mutex protected critical section locks out other + * May allocate memory. Mutex-protected critical section locks out other * threads for a short time. * *---------------------------------------------------------------------- @@ -2340,7 +2339,7 @@ FreeReflectedChannel( * InvokeTclMethod -- * * This function is used to invoke the Tcl level of a reflected channel. - * It handles all the command assembly, invokation, and generic state and + * It handles all the command assembly, invocation, and generic state and * result mgmt. It does *not* handle thread redirection; that is the * responsibility of clients of this function. * @@ -2368,8 +2367,8 @@ InvokeTclMethod( { Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ - int result; /* Result code of method invokation */ - Tcl_Obj *resObj = NULL; /* Result of method invokation. */ + int result; /* Result code of method invocation */ + Tcl_Obj *resObj = NULL; /* Result of method invocation. */ Tcl_Obj *cmd; if (rcPtr->dead) { @@ -2452,7 +2451,7 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { - size_t cmdLen; + Tcl_Size cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); @@ -2588,7 +2587,7 @@ GetReflectedChannelMap( * * Side effects: * Deletes the hash table of channels. May close channels. May flush - * output on closed channels. Removes any channeEvent handlers that were + * output on closed channels. Removes any channelEvent handlers that were * registered in this interpreter. * *---------------------------------------------------------------------- @@ -3125,7 +3124,7 @@ ForwardProc( * Process a regular result. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); @@ -3137,7 +3136,7 @@ ForwardProc( ForwardSetStaticError(paramPtr, msg_read_toomuch); paramPtr->input.toRead = TCL_IO_FAILURE; } else { - if (bytec + 1 > 1) { + if (bytec > 0) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; @@ -3307,7 +3306,7 @@ ForwardProc( * NOTE (4) as well. */ - size_t listc; + Tcl_Size listc; Tcl_Obj **listv; if (TclListObjGetElementsM(interp, resObj, &listc, @@ -3321,13 +3320,13 @@ ForwardProc( */ char *buf = (char *)Tcl_Alloc(200); - sprintf(buf, - "{Expected list with even number of elements, got %" TCL_Z_MODIFIER "u %s instead}", + snprintf(buf, 200, + "{Expected list with even number of elements, got %" TCL_SIZE_MODIFIER "u %s instead}", listc, (listc == 1 ? "element" : "elements")); ForwardSetDynamicError(paramPtr, buf); } else { - size_t len; + Tcl_Size len; const char *str = Tcl_GetStringFromObj(resObj, &len); if (len) { @@ -3439,7 +3438,7 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - size_t len; + Tcl_Size len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index ebaa8408ed4d..90e7195edc13 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -264,7 +264,7 @@ struct ForwardParamTransform { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* I: Bytes to transform, * O: Bytes in transform result */ - size_t size; /* I: #bytes to transform, + Tcl_Size size; /* I: #bytes to transform, * O: #bytes in the transform result */ }; struct ForwardParamLimit { @@ -511,7 +511,7 @@ TclChanPushObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - size_t listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -634,7 +634,7 @@ TclChanPushObjCmd( /* * Mode tell us what the parent channel supports. The methods tell us what * the handler supports. We remove the non-supported bits from the mode - * and check that the channel is not completely inacessible. Afterward the + * and check that the channel is not completely inaccessible. Afterward the * mode tells us which methods are still required, and these methods will * also be supported by the handler, by design of the check. */ @@ -820,10 +820,10 @@ UnmarshallErrorResult( Tcl_Interp *interp, Tcl_Obj *msgObj) { - size_t lc; + Tcl_Size lc; Tcl_Obj **lv; int explicitResult; - size_t numOptions; + Tcl_Size numOptions; /* * Process the caught message. @@ -866,7 +866,7 @@ UnmarshallErrorResult( * driver specific instance data. * * Results: - * A posix error. + * A Posix error. * * Side effects: * Releases memory. Arbitrary, as it calls upon a script. @@ -985,7 +985,7 @@ ReflectClose( #endif /* TCL_THREADS */ /* - * Do the actual invokation of "finalize" now; we're in the right thread. + * Do the actual invocation of "finalize" now; we're in the right thread. */ result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj); @@ -1449,7 +1449,7 @@ ReflectWatch( * is required of it. * * Results: - * A posix error number. + * A Posix error number. * * Side effects: * Allocates memory. Arbitrary, as it calls upon a script. @@ -1536,7 +1536,7 @@ static int ReflectGetOption( void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ - const char *optionName, /* Name of reuqested option */ + const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ { ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; @@ -1591,7 +1591,7 @@ ReflectHandle( /* * Transformations have no handle of their own. As such we simply query - * the parent channel for it. This way the qery will ripple down through + * the parent channel for it. This way the query will ripple down through * all transformations until reaches the base channel. Which then returns * its handle, or fails. The former will then ripple up the stack. * @@ -1625,7 +1625,7 @@ ReflectNotify( ReflectedTransform *rtPtr = (ReflectedTransform *)clientData; /* - * An event occured in the underlying channel. + * An event occurred in the underlying channel. * * We delete our timer. It was not fired, yet we are here, so the channel * below generated such an event and we don't have to. The renewal of the @@ -1719,7 +1719,7 @@ NewReflectedTransform( Tcl_Channel parentChan) { ReflectedTransform *rtPtr; - size_t i, listc; + Tcl_Size i, listc; Tcl_Obj **listv; rtPtr = (ReflectedTransform *)Tcl_Alloc(sizeof(ReflectedTransform)); @@ -1887,7 +1887,7 @@ FreeReflectedTransform( * InvokeTclMethod -- * * This function is used to invoke the Tcl level of a reflected channel. - * It handles all the command assembly, invokation, and generic state and + * It handles all the command assembly, invocation, and generic state and * result mgmt. It does *not* handle thread redirection; that is the * responsibility of clients of this function. * @@ -1919,8 +1919,8 @@ InvokeTclMethod( int cmdc; /* #words in constructed command */ Tcl_Obj *methObj = NULL; /* Method name in object form */ Tcl_InterpState sr; /* State of handler interp */ - int result; /* Result code of method invokation */ - Tcl_Obj *resObj = NULL; /* Result of method invokation. */ + int result; /* Result code of method invocation */ + Tcl_Obj *resObj = NULL; /* Result of method invocation. */ if (rtPtr->dead) { /* @@ -1944,7 +1944,7 @@ InvokeTclMethod( */ /* - * Insert method into the pre-allocated area, after the command prefix, + * Insert method into the preallocated area, after the command prefix, * before the channel id. */ @@ -1971,7 +1971,7 @@ InvokeTclMethod( } /* - * And run the handler... This is done in auch a manner which leaves any + * And run the handler... This is done in a manner which leaves any * existing state intact. */ @@ -2004,7 +2004,7 @@ InvokeTclMethod( */ if (result != TCL_ERROR) { Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv); - size_t cmdLen; + Tcl_Size cmdLen; const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen); Tcl_IncrRefCount(cmd); @@ -2562,7 +2562,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2596,7 +2596,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2626,7 +2626,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ bytev = Tcl_GetByteArrayFromObj(resObj, &bytec); @@ -2652,7 +2652,7 @@ ForwardProc( * Sent it back to the request originator. */ - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ @@ -2770,7 +2770,7 @@ ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) { - size_t len; + Tcl_Size len; const char *msgStr = Tcl_GetStringFromObj(obj, &len); len++; @@ -2873,7 +2873,7 @@ TimerRun( * ResultInit -- * * Initializes the specified buffer structure. The structure will contain - * valid information for an emtpy buffer. + * valid information for an empty buffer. * * Side effects: * See above. @@ -3045,7 +3045,7 @@ TransformRead( Tcl_Obj *bufObj) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3100,7 +3100,7 @@ TransformWrite( { Tcl_Obj *bufObj; Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; @@ -3167,7 +3167,7 @@ TransformDrain( int *errorCodePtr) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ /* @@ -3216,7 +3216,7 @@ TransformFlush( int op) { Tcl_Obj *resObj; - size_t bytec = 0; /* Number of returned bytes */ + Tcl_Size bytec = 0; /* Number of returned bytes */ unsigned char *bytev; /* Array of returned bytes */ int res; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index a925c3d3b50d..c6cef5526010 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -117,13 +117,13 @@ TclSockGetPort( int TclSockMinimumBuffers( void *sock, /* Socket file descriptor */ - size_t size1) /* Minimum buffer size */ + Tcl_Size size1) /* Minimum buffer size */ { int current; socklen_t len; int size = size1; - if ((size_t)size != size1) { + if (size != size1) { return TCL_ERROR; } len = sizeof(int); diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 436d3649e3ff..cec6ad3a638d 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -178,7 +178,7 @@ const Tcl_Filesystem tclNativeFilesystem = { /* * An initial record in the linked list for the native filesystem. Remains at * the tail of the list and is never freed. Currently the native filesystem is - * hard-coded. It may make sense to modify this to accomodate unconventional + * hard-coded. It may make sense to modify this to accommodate unconventional * uses of Tcl that provide no native filesystem. */ @@ -293,7 +293,7 @@ Tcl_Stat( #endif /* !TCL_WIDE_INT_IS_LONG */ /* - * Copy across all supported fields, with possible type coercions on + * Copy across all supported fields, with possible type coercion on * those fields that change between the normal and lf64 versions of * the stat structure (on Solaris at least). This is slow when the * structure sizes coincide, but that's what you get for using an @@ -521,7 +521,7 @@ TclFSCwdPointerEquals( if (tsdPtr->cwdPathPtr == *pathPtrPtr) { return 1; } else { - size_t len1, len2; + Tcl_Size len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); @@ -663,7 +663,7 @@ FsUpdateCwd( Tcl_Obj *cwdObj, void *clientData) { - size_t len = 0; + Tcl_Size len = 0; const char *str = NULL; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey); @@ -989,7 +989,7 @@ Tcl_FSMatchInDirectory( { const Tcl_Filesystem *fsPtr; Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr; - size_t resLength, i; + Tcl_Size resLength, i; int ret = -1; if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) { @@ -1106,7 +1106,7 @@ FsAddMountsToGlobResult( * directory flag is particularly significant. */ { - size_t mLength, gLength, i; + Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); Tcl_Obj *mounts = FsListMounts(pathPtr, pattern); @@ -1122,7 +1122,7 @@ FsAddMountsToGlobResult( } for (i=0 ; i limit); @@ -2063,8 +2063,7 @@ Tcl_PosixError( * Tcl_FSStat -- * Calls 'statProc' of the filesystem corresponding to pathPtr. * - * Replaces the standard library routines stat. - * + * Replaces the standard library "stat" routine. * * Results: * See stat documentation. @@ -2459,7 +2458,7 @@ TclFSFileAttrIndex( * It's a constant attribute table, so use T_GIFO. */ - Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, TCL_INDEX_NONE); + Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, -1); int result; result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT, @@ -2474,7 +2473,7 @@ TclFSFileAttrIndex( * It's a non-constant attribute list, so do a literal search. */ - size_t i, objc; + Tcl_Size i, objc; Tcl_Obj **objv; if (TclListObjGetElementsM(NULL, listObj, &objc, &objv) != TCL_OK) { @@ -2795,7 +2794,7 @@ Tcl_FSGetCwd( * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr. */ - size_t len1, len2; + Tcl_Size len1, len2; const char *str1, *str2; str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1); @@ -3292,7 +3291,7 @@ Tcl_LoadFile( Tcl_DecrRefCount(copyToPtr); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "couldn't load from current filesystem", TCL_INDEX_NONE)); + "couldn't load from current filesystem", -1)); } return TCL_ERROR; } @@ -3876,13 +3875,13 @@ FsListMounts( Tcl_Obj * Tcl_FSSplitPath( Tcl_Obj *pathPtr, /* The pathname to split. */ - size_t *lenPtr) /* A place to hold the number of pathname + Tcl_Size *lenPtr) /* A place to hold the number of pathname * elements. */ { Tcl_Obj *result = NULL; /* Just to squelch gcc warnings. */ const Tcl_Filesystem *fsPtr; char separator = '/'; - size_t driveNameLength; + Tcl_Size driveNameLength; const char *p; /* @@ -3928,7 +3927,7 @@ Tcl_FSSplitPath( for (;;) { const char *elementStart = p; - size_t length; + Tcl_Size length; while ((*p != '\0') && (*p != separator)) { p++; @@ -3973,14 +3972,14 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - size_t *driveNameLengthPtr, /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a * refCount of 1, and whose value is the name * of the volume. */ { - size_t pathLen; + Tcl_Size pathLen; const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); Tcl_PathType type; @@ -4022,12 +4021,12 @@ TclGetPathType( Tcl_PathType TclFSNonnativePathType( const char *path, /* Pathname to determine the type of. */ - size_t pathLen, /* Length of the pathname. */ + Tcl_Size pathLen, /* Length of the pathname. */ const Tcl_Filesystem **filesystemPtrPtr, /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ - size_t *driveNameLengthPtr, /* If not NULL, a place to store the length of + Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of * the volume name if the pathname is absolute. */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to @@ -4064,7 +4063,7 @@ TclFSNonnativePathType( if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (fsRecPtr->fsPtr->listVolumesProc != NULL)) { - size_t numVolumes; + Tcl_Size numVolumes; Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { @@ -4081,9 +4080,9 @@ TclFSNonnativePathType( numVolumes = TCL_INDEX_NONE; } - while (numVolumes + 1 > 1) { + while (numVolumes > 0) { Tcl_Obj *vol; - size_t len; + Tcl_Size len; const char *strVol; numVolumes--; @@ -4430,7 +4429,7 @@ Tcl_FSRemoveDirectory( Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL); if (cwdPtr != NULL) { const char *cwdStr, *normPathStr; - size_t cwdLen, normLen; + Tcl_Size cwdLen, normLen; Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr); if (normPath != NULL) { @@ -4612,7 +4611,7 @@ Tcl_FSFileSystemInfo( resPtr = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(NULL, resPtr, - Tcl_NewStringObj(fsPtr->typeName, TCL_INDEX_NONE)); + Tcl_NewStringObj(fsPtr->typeName, -1)); if (fsPtr->filesystemPathTypeProc != NULL) { Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr); diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index 66d7f30e2225..5697fd82948c 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -14,6 +14,7 @@ */ #include "tclInt.h" +#include /* * Prototypes for functions defined later in this file: @@ -55,8 +56,8 @@ static const Tcl_ObjType indexType = { typedef struct { void *tablePtr; /* Pointer to the table of strings */ - size_t offset; /* Offset between table entries */ - size_t index; /* Selected index into table. */ + Tcl_Size offset; /* Offset between table entries */ + Tcl_Size index; /* Selected index into table. */ } IndexRep; /* @@ -107,14 +108,14 @@ GetIndexFromObjList( int *indexPtr) /* Place to store resulting integer index. */ { - size_t objc, t; + Tcl_Size objc, t; int result; Tcl_Obj **objv; const char **tablePtr; /* * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most - * of the code there. This is a bit ineffiecient but simpler. + * of the code there. This is a bit inefficient but simpler. */ result = TclListObjGetElementsM(interp, tableObjPtr, &objc, &objv); @@ -122,6 +123,9 @@ GetIndexFromObjList( return result; } + /* Return type is int* so caller should not be passing larger table */ + assert(objc <= INT_MAX); + /* * Build a string table from the list. */ @@ -134,7 +138,7 @@ GetIndexFromObjList( */ Tcl_Free((void *)tablePtr); - *indexPtr = t; + *indexPtr = (int) t; return TCL_OK; } @@ -187,13 +191,13 @@ Tcl_GetIndexFromObjStruct( * offset, the third plus the offset again, * etc. The last entry must be NULL and there * must not be duplicate entries. */ - size_t offset, /* The number of bytes between entries */ + Tcl_Size offset, /* The number of bytes between entries */ const char *msg, /* Identifying word to use in error * messages. */ int flags, /* 0, TCL_EXACT, TCL_NULL_OK or TCL_INDEX_TEMP_TABLE */ void *indexPtr) /* Place to store resulting index. */ { - size_t index, idx, numAbbrev; + Tcl_Size index, idx, numAbbrev; const char *key, *p1; const char *p2; const char *const *entryPtr; @@ -201,9 +205,8 @@ Tcl_GetIndexFromObjStruct( IndexRep *indexRep; const Tcl_ObjInternalRep *irPtr; - /* Protect against invalid values, like TCL_INDEX_NONE or 0. */ - if (offset+1 <= sizeof(char *)) { - offset = sizeof(char *); + if (offset < (Tcl_Size) sizeof(char *)) { + return TclIndexInvalidError(interp, "struct offset", offset); } /* * See if there is a valid cached result from a previous lookup. @@ -505,7 +508,7 @@ PrefixMatchObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int flags = 0, result, dummy, i; - size_t dummyLength, errorLength; + Tcl_Size dummyLength, errorLength; Tcl_Obj *errorPtr = NULL; const char *message = "option"; Tcl_Obj *tablePtr, *objPtr, *resultPtr; @@ -533,7 +536,7 @@ PrefixMatchObjCmd( case PRFMATCH_MESSAGE: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value for -message", TCL_INDEX_NONE)); + "missing value for -message", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } @@ -543,7 +546,7 @@ PrefixMatchObjCmd( case PRFMATCH_ERROR: if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "missing value for -error", TCL_INDEX_NONE)); + "missing value for -error", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL); return TCL_ERROR; } @@ -629,7 +632,7 @@ PrefixAllObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int result; - size_t length, elemLength, tableObjc, t; + Tcl_Size length, elemLength, tableObjc, t; const char *string, *elemString; Tcl_Obj **tableObjv, *resultPtr; @@ -687,7 +690,7 @@ PrefixLongestObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int result; - size_t i, length, elemLength, resultLength, tableObjc, t; + Tcl_Size i, length, elemLength, resultLength, tableObjc, t; const char *string, *elemString, *resultString; Tcl_Obj **tableObjv; @@ -802,7 +805,7 @@ PrefixLongestObjCmd( void Tcl_WrongNumArgs( Tcl_Interp *interp, /* Current interpreter. */ - size_t objc, /* Number of arguments to print from objv. */ + Tcl_Size objc, /* Number of arguments to print from objv. */ Tcl_Obj *const objv[], /* Initial argument objects, which should be * included in the error message. */ const char *message) /* Error message to print after the leading @@ -810,7 +813,7 @@ Tcl_WrongNumArgs( * NULL. */ { Tcl_Obj *objPtr; - size_t i, len, elemLen; + Tcl_Size i, len, elemLen; char flags; Interp *iPtr = (Interp *)interp; const char *elementStr; @@ -819,9 +822,9 @@ Tcl_WrongNumArgs( if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp)); - Tcl_AppendToObj(objPtr, " or \"", TCL_INDEX_NONE); + Tcl_AppendToObj(objPtr, " or \"", -1); } else { - Tcl_AppendToObj(objPtr, "wrong # args: should be \"", TCL_INDEX_NONE); + Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1); } /* @@ -830,8 +833,8 @@ Tcl_WrongNumArgs( */ if (iPtr->ensembleRewrite.sourceObjs != NULL) { - size_t toSkip = iPtr->ensembleRewrite.numInsertedObjs; - size_t toPrint = iPtr->ensembleRewrite.numRemovedObjs; + Tcl_Size toSkip = iPtr->ensembleRewrite.numInsertedObjs; + Tcl_Size toPrint = iPtr->ensembleRewrite.numRemovedObjs; Tcl_Obj *const *origObjv = TclEnsembleGetRewriteValues(interp); /* @@ -889,7 +892,7 @@ Tcl_WrongNumArgs( * moderately complex condition here). */ - if (i+1 INT_MAX) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "too many (%" TCL_Z_MODIFIER "u) arguments for TCL_ARGV_GENFUNC", objc)); + "too many (%" TCL_SIZE_MODIFIER "d) arguments for TCL_ARGV_GENFUNC", objc)); goto error; } Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *) infoPtr->srcPtr; - i = handlerProc(infoPtr->clientData, interp, i, + int i = handlerProc(infoPtr->clientData, interp, (int) objc, &objv[srcIndex], infoPtr->dstPtr); if (i < 0) { goto error; @@ -1274,13 +1276,13 @@ PrintUsage( width = 4; for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { - size_t length; + Tcl_Size length; if (infoPtr->keyStr == NULL) { continue; } length = strlen(infoPtr->keyStr); - if (length > (size_t)width) { + if (length > width) { width = length; } } @@ -1289,7 +1291,7 @@ PrintUsage( * Now add the option information, with pretty-printing. */ - msg = Tcl_NewStringObj("Command-specific options:", TCL_INDEX_NONE); + msg = Tcl_NewStringObj("Command-specific options:", -1); for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) { if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) { Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr); @@ -1305,7 +1307,7 @@ PrintUsage( } numSpaces -= NUM_SPACES; } - Tcl_AppendToObj(msg, infoPtr->helpStr, TCL_INDEX_NONE); + Tcl_AppendToObj(msg, infoPtr->helpStr, -1); switch (infoPtr->type) { case TCL_ARGV_INT: Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d", diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 10cfbf6b9f51..78e87ac5c93d 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -349,8 +349,9 @@ declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData) } +# Do NOT change width of the size. TclEmitPush cannot handle it declare 143 { - Tcl_Size TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, + int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr) } declare 144 { @@ -663,8 +664,9 @@ declare 250 { } # Allow extensions for optimization +# Do NOT change width of the size. TclEmitPush cannot handle it declare 251 { - Tcl_Size TclRegisterLiteral(void *envPtr, + int TclRegisterLiteral(void *envPtr, const char *bytes, Tcl_Size length, int flags) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 38f4c2f6facd..82dd573d1555 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -108,7 +108,7 @@ * Maximum *signed* value that can be stored in a Tcl_Size type. This is * primarily used for checking overflows in dynamically allocating memory. */ -#define TCL_SIZE_SMAX ((((Tcl_Size) 1) << ((8*sizeof(Tcl_Size)) - 1)) - 1) +#define TCL_SIZE_SMAX ((((Tcl_Size) 1) << ((8*(Tcl_Size)sizeof(Tcl_Size)) - 1)) - 1) /* * Macros used to cast between pointers and integers (e.g. when storing an int @@ -131,6 +131,7 @@ #if defined(_WIN32) && defined(_MSC_VER) # define vsnprintf _vsnprintf +# define snprintf _snprintf #endif #if !defined(TCL_THREADS) @@ -221,10 +222,10 @@ typedef struct Tcl_Ensemble Tcl_Ensemble; typedef struct NamespacePathEntry NamespacePathEntry; /* - * Special hashtable for variables: this is just a Tcl_HashTable with nsPtr - * and arrayPtr fields added at the end: in this way variables can find their + * Special hashtable for variables: This is just a Tcl_HashTable with nsPtr + * and arrayPtr fields added at the end so that variables can find their * namespace and possibly containing array without having to copy a pointer in - * their struct: they can access them via their hPtr->tablePtr. + * their struct by accessing them via their hPtr->tablePtr. */ typedef struct TclVarHashTable { @@ -478,7 +479,7 @@ typedef struct EnsembleConfig { * all lists, and cannot be found by scanning * the list from the namespace's ensemble * field. */ - int flags; /* ORed combo of TCL_ENSEMBLE_PREFIX, + int flags; /* OR'ed combo of TCL_ENSEMBLE_PREFIX, * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */ /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */ @@ -505,7 +506,7 @@ typedef struct EnsembleConfig { * results passed directly back to the caller * (including the error code) unless the code * is TCL_CONTINUE in which case the - * subcommand will be reparsed by the ensemble + * subcommand will be re-parsed by the ensemble * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ @@ -649,7 +650,7 @@ typedef struct VarInHash { Tcl_HashEntry entry; /* The hash table entry that refers to this * variable. This is used to find the name of * the variable and to delete it from its - * hashtable if it is no longer needed. It + * hash table if it is no longer needed. It * also holds the variable's name. */ } VarInHash; @@ -660,7 +661,7 @@ typedef struct VarInHash { * * VAR_ARRAY - 1 means this is an array variable rather than * a scalar variable or link. The "tablePtr" - * field points to the array's hashtable for its + * field points to the array's hash table for its * elements. * VAR_LINK - 1 means this Var structure contains a pointer * to another Var structure that either has the @@ -673,12 +674,12 @@ typedef struct VarInHash { * Flags that indicate the type and status of storage; none is set for * compiled local variables (Var structs). * - * VAR_IN_HASHTABLE - 1 means this variable is in a hashtable and - * the Var structure is malloced. 0 if it is a + * VAR_IN_HASHTABLE - 1 means this variable is in a hash table and + * the Var structure is malloc'ed. 0 if it is a * local variable that was assigned a slot in a * procedure frame by the compiler so the Var * storage is part of the call frame. - * VAR_DEAD_HASH 1 means that this var's entry in the hashtable + * VAR_DEAD_HASH 1 means that this var's entry in the hash table * has already been deleted. * VAR_ARRAY_ELEMENT - 1 means that this variable is an array * element, so it is not legal for it to be an @@ -1094,7 +1095,7 @@ typedef struct ActiveInterpTrace { typedef struct { /* For internal core use only */ Tcl_ObjType objType; struct { - size_t (*lengthProc)(Tcl_Obj *obj); + Tcl_Size (*lengthProc)(Tcl_Obj *obj); } abstractList; } TclObjTypeWithAbstractList; #define TCL_OBJTYPE_V0_1(lengthProc) (sizeof(TclObjTypeWithAbstractList)) \ @@ -1103,7 +1104,7 @@ typedef struct { /* For internal core use only */ && ((objPtr)->typePtr->version > offsetof(TclObjTypeWithAbstractList, abstractList.proc))) ? \ ((const TclObjTypeWithAbstractList *)(objPtr)->typePtr)->abstractList.proc : NULL) -MODULE_SCOPE size_t TclLengthOne(Tcl_Obj *); +MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); /* * The structure below defines an entry in the assocData hash table which is @@ -1316,7 +1317,7 @@ typedef struct CFWordBC { struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See * CmdFrame litarg field for the list start. */ - Tcl_Obj *obj; /* Back reference to hashtable key */ + Tcl_Obj *obj; /* Back reference to hash table key */ } CFWordBC; /* @@ -1330,7 +1331,7 @@ typedef struct CFWordBC { * * These structures are allocated and filled by both the function * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the - * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in + * file "tclBasic.c", and stored in the thread-global hash table "lineCLPtr" in * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and * TclCompileScript(), both found in the file "tclCompile.c". Their memory is * released by the function TclFreeObj(), in the file "tclObj.c", and also by @@ -2450,16 +2451,6 @@ typedef enum TclEolTranslation { #define TCL_INVOKE_NO_UNKNOWN (1<<1) #define TCL_INVOKE_NO_TRACEBACK (1<<2) -#if TCL_MAJOR_VERSION > 8 -/* - * SSIZE_MAX, NOT SIZE_MAX as negative differences need to be expressed - * between values of the Tcl_Size type so limit the range to signed - */ -# define ListSizeT_MAX ((Tcl_Size)PTRDIFF_MAX) -#else -# define ListSizeT_MAX INT_MAX -#endif - /* * ListStore -- * @@ -2500,11 +2491,11 @@ typedef struct ListStore { /* Max number of elements that can be contained in a list */ #define LIST_MAX \ - ((ListSizeT_MAX - offsetof(ListStore, slots)) \ - / sizeof(Tcl_Obj *)) + ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *))) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ - (offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *))) + ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) /* * ListSpan -- @@ -2513,7 +2504,7 @@ typedef struct ListStore { typedef struct ListSpan { Tcl_Size spanStart; /* Starting index of the span */ Tcl_Size spanLength; /* Number of elements in the span */ - size_t refCount; /* Count of references to this span record */ + Tcl_Size refCount; /* Count of references to this span record */ } ListSpan; #ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ #define LIST_SPAN_THRESHOLD 101 @@ -2699,7 +2690,7 @@ typedef struct ListRep { : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ ((((objPtr)->typePtr == &tclIntType.objType) && ((objPtr)->internalRep.wideValue >= 0) \ - && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (Tcl_WideUInt)(endValue + 1))) \ + && ((objPtr)->internalRep.wideValue <= endValue)) \ ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) @@ -2864,6 +2855,22 @@ typedef struct ProcessGlobalValue { #define TCL_PARSE_NO_UNDERSCORE 128 /* Reject underscore digit separator */ + +/* + *---------------------------------------------------------------------- + * Internal convenience macros for manipulating encoding flags. See + * TCL_ENCODING_PROFILE_* in tcl.h + *---------------------------------------------------------------------- + */ + +#define ENCODING_PROFILE_MASK 0xFF000000 +#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= profile_; \ + } while (0) + /* *---------------------------------------------------------------- * Variables shared among Tcl modules but not used by the outside world. @@ -3053,12 +3060,12 @@ struct Tcl_LoadHandle_ { #if TCL_MAJOR_VERSION > 8 MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, - const unsigned char *bytes, size_t len); + const unsigned char *bytes, Tcl_Size len); MODULE_SCOPE int TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); -MODULE_SCOPE void TclAdvanceContinuations(size_t *line, int **next, +MODULE_SCOPE void TclAdvanceContinuations(Tcl_Size *line, int **next, int loc); -MODULE_SCOPE void TclAdvanceLines(size_t *line, const char *start, +MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start, const char *end); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, CmdFrame *cf); @@ -3066,7 +3073,7 @@ MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], int objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc); + void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -3076,8 +3083,8 @@ MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId, MODULE_SCOPE void TclAsyncMarkFromNotifier(void); MODULE_SCOPE double TclBignumToDouble(const void *bignum); MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string, - size_t strLen, const unsigned char *pattern, - size_t ptnLen, int flags); + Tcl_Size strLen, const unsigned char *pattern, + Tcl_Size ptnLen, int flags); MODULE_SCOPE double TclCeil(const void *a); MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan); MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan); @@ -3090,14 +3097,14 @@ MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd; MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble; MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr); -MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, size_t num, +MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num, int *loc); MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr, int start, int *clNext); MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr); MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr, Tcl_Obj *originObjPtr); -MODULE_SCOPE size_t TclConvertElement(const char *src, size_t length, +MODULE_SCOPE Tcl_Size TclConvertElement(const char *src, Tcl_Size length, char *dst, int flags); MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp, const char *cmdName, Tcl_Namespace *nsPtr, @@ -3109,12 +3116,12 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp, MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); MODULE_SCOPE void TclDeleteNamespaceChildren(Namespace *nsPtr); MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp, - const char *dict, size_t dictLength, + const char *dict, Tcl_Size dictLength, const char **elementPtr, const char **nextPtr, - size_t *sizePtr, int *literalPtr); + Tcl_Size *sizePtr, int *literalPtr); /* TIP #280 - Modified token based evaluation, with line information. */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, - size_t numBytes, int flags, size_t line, + Tcl_Size numBytes, int flags, Tcl_Size line, int *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd; MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd; @@ -3136,7 +3143,7 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, - Tcl_Obj *const *objv, size_t objc, size_t *objcPtr); + Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); @@ -3190,7 +3197,7 @@ MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, - TCL_HASH_TYPE *sizePtr); + Tcl_Size *sizePtr); MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp, const char *targetName, const char *packageName); @@ -3220,7 +3227,7 @@ MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsDigitProc(int byte); MODULE_SCOPE int TclIsBareword(int byte); -MODULE_SCOPE Tcl_Obj * TclJoinPath(size_t elements, Tcl_Obj * const objv[], +MODULE_SCOPE Tcl_Obj * TclJoinPath(Tcl_Size elements, Tcl_Obj * const objv[], int forceRelative); MODULE_SCOPE int MakeTildeRelativePath(Tcl_Interp *interp, const char *user, const char *subPath, Tcl_DString *dsPtr); @@ -3232,25 +3239,25 @@ MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, - size_t indexCount, Tcl_Obj *const indexArray[]); + Tcl_Size indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */ -MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, size_t line, int n, +MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n, int *lines, Tcl_Obj *const *elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclListObjAppendElements(Tcl_Interp *interp, - Tcl_Obj *toObj, size_t elemCount, + Tcl_Obj *toObj, Tcl_Size elemCount, Tcl_Obj *const elemObjv[]); -MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, size_t fromIdx, - size_t toIdx); +MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx); MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, - size_t indexCount, Tcl_Obj *const indexArray[], + Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, const EnsembleImplMap map[]); MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp); -MODULE_SCOPE int TclMaxListLength(const char *bytes, size_t numBytes, +MODULE_SCOPE Tcl_Size TclMaxListLength(const char *bytes, Tcl_Size numBytes, const char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, @@ -3268,15 +3275,15 @@ MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE int TclParseBackslash(const char *src, - size_t numBytes, size_t *readPtr, char *dst); -MODULE_SCOPE int TclParseHex(const char *src, size_t numBytes, + Tcl_Size numBytes, Tcl_Size *readPtr, char *dst); +MODULE_SCOPE int TclParseHex(const char *src, Tcl_Size numBytes, int *resultPtr); MODULE_SCOPE int TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr, const char *expected, const char *bytes, - size_t numBytes, const char **endPtrPtr, int flags); + Tcl_Size numBytes, const char **endPtrPtr, int flags); MODULE_SCOPE void TclParseInit(Tcl_Interp *interp, const char *string, - size_t numBytes, Tcl_Parse *parsePtr); -MODULE_SCOPE size_t TclParseAllWhiteSpace(const char *src, size_t numBytes); + Tcl_Size numBytes, Tcl_Parse *parsePtr); +MODULE_SCOPE Tcl_Size TclParseAllWhiteSpace(const char *src, Tcl_Size numBytes); MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, int code, int level, Tcl_Obj *returnOpts); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); @@ -3284,7 +3291,7 @@ MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, - size_t len); + Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); MODULE_SCOPE void *TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); @@ -3311,7 +3318,7 @@ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); -MODULE_SCOPE size_t TclpFindVariable(const char *name, size_t *lengthPtr); +MODULE_SCOPE Tcl_Size TclpFindVariable(const char *name, Tcl_Size *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); @@ -3326,9 +3333,9 @@ MODULE_SCOPE int TclpMatchFiles(Tcl_Interp *interp, char *separators, MODULE_SCOPE int TclpObjNormalizePath(Tcl_Interp *interp, Tcl_Obj *pathPtr, int nextCheckpoint); MODULE_SCOPE void TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining); -MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, size_t *lenPtr); +MODULE_SCOPE Tcl_Obj * TclpNativeSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr); MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr, - size_t *driveNameLengthPtr, Tcl_Obj **driveNameRef); + Tcl_Size *driveNameLengthPtr, Tcl_Obj **driveNameRef); MODULE_SCOPE int TclCrossFilesystemCopy(Tcl_Interp *interp, Tcl_Obj *source, Tcl_Obj *target); MODULE_SCOPE int TclpMatchInDirectory(Tcl_Interp *interp, @@ -3358,9 +3365,9 @@ MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex); MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex); MODULE_SCOPE void TclRemoveScriptLimitCallbacks(Tcl_Interp *interp); MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr, - size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr, + Tcl_Size reStrLen, Tcl_DString *dsPtr, int *flagsPtr, int *quantifiersFoundPtr); -MODULE_SCOPE TCL_HASH_TYPE TclScanElement(const char *string, size_t length, +MODULE_SCOPE Tcl_Size TclScanElement(const char *string, Tcl_Size length, char *flagPtr); MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp, Tcl_Obj *cmdPrefix); @@ -3374,44 +3381,44 @@ MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, Tcl_Obj *newValue, Tcl_Encoding encoding); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, - Tcl_Obj *const *objv, size_t objc, size_t subIdx, + Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx, Tcl_Obj *bad, Tcl_Obj *fix); MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr, - size_t numBytes); + Tcl_Size numBytes); typedef int (*memCmpFn_t)(const void*, const void*, size_t); MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr, - int checkEq, int nocase, size_t reqlength); + int checkEq, int nocase, Tcl_Size reqlength); MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int *nocase, - int *reqlength); -MODULE_SCOPE int TclStringMatch(const char *str, size_t strLen, + Tcl_Size *reqlength); +MODULE_SCOPE int TclStringMatch(const char *str, Tcl_Size strLen, const char *pattern, int ptnLen, int flags); MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes, - size_t numBytes, int flags, size_t line, + Tcl_Size numBytes, int flags, Tcl_Size line, struct CompileEnv *envPtr); -MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, size_t numOpts, +MODULE_SCOPE int TclSubstOptions(Tcl_Interp *interp, Tcl_Size numOpts, Tcl_Obj *const opts[], int *flagPtr); MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes, - size_t numBytes, int flags, Tcl_Parse *parsePtr, + Tcl_Size numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - size_t count, int *tokensLeftPtr, size_t line, + Tcl_Size count, int *tokensLeftPtr, Tcl_Size line, int *clNextOuter, const char *outerScript); -MODULE_SCOPE size_t TclTrim(const char *bytes, size_t numBytes, - const char *trim, size_t numTrim, size_t *trimRight); -MODULE_SCOPE size_t TclTrimLeft(const char *bytes, size_t numBytes, - const char *trim, size_t numTrim); -MODULE_SCOPE size_t TclTrimRight(const char *bytes, size_t numBytes, - const char *trim, size_t numTrim); +MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes, + const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); +MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, + const char *trim, Tcl_Size numTrim); +MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, + const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); MODULE_SCOPE void TclRegisterCommandTypeName( Tcl_ObjCmdProc *implementationProc, const char *nameStr); MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct); MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct); -MODULE_SCOPE size_t TclUtfCount(int ch); +MODULE_SCOPE int TclUtfCount(int ch); #if TCL_UTF_MAX > 3 # define TclUtfToUCS4 Tcl_UtfToUniChar # define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1) @@ -3458,7 +3465,7 @@ MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr); MODULE_SCOPE void TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr); MODULE_SCOPE void * TclpThreadGetGlobalTSD(void *tsdKeyPtr); MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, - const char *msg, size_t length); + const char *msg, Tcl_Size length); /* Tip 430 */ MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp); @@ -3507,7 +3514,7 @@ MODULE_SCOPE int TclDictWithFinish(Tcl_Interp *interp, Var *varPtr, Tcl_Obj *part2Ptr, int index, int pathc, Tcl_Obj *const pathv[], Tcl_Obj *keysPtr); MODULE_SCOPE Tcl_Obj * TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr, - size_t pathc, Tcl_Obj *const pathv[]); + Tcl_Size pathc, Tcl_Obj *const pathv[]); MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd; /* Assemble command function */ @@ -4030,16 +4037,16 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, * candidates for public interface. */ -MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc, +MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags); MODULE_SCOPE Tcl_Obj * TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack, - size_t start); + Tcl_Size start); MODULE_SCOPE Tcl_Obj * TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack, - size_t last); + Tcl_Size last); MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t count, int flags); + Tcl_Size count, int flags); MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t first, size_t count, Tcl_Obj *insertPtr, + Tcl_Size first, Tcl_Size count, Tcl_Obj *insertPtr, int flags); MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags); @@ -4166,14 +4173,52 @@ MODULE_SCOPE Tcl_Obj * TclGetArrayDefault(Var *arrayPtr); */ MODULE_SCOPE int TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t before, size_t after, int *indexPtr); -MODULE_SCOPE size_t TclIndexDecode(int encoded, size_t endValue); + int before, int after, int *indexPtr); +MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); +MODULE_SCOPE int TclIndexInvalidError(Tcl_Interp *interp, + const char *idxType, Tcl_Size idx); + +/* + * Error message utility functions + */ +MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); + #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ #define TCL_INDEX_END ((Tcl_Size)-2) #define TCL_INDEX_START ((Tcl_Size)0) +/* + *------------------------------------------------------------------------ + * + * TclGetSizeIntFromObj -- + * + * Extract a Tcl_Size from a Tcl_Obj + * + * Results: + * TCL_OK / TCL_ERROR + * + * Side effects: + * On success, the integer value is stored in *sizePtr. On error, + * an error message in interp it it is not NULL. + * + *------------------------------------------------------------------------ + */ +static inline int TclGetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr) { +#if TCL_SIZE_MAX == INT_MAX + return TclGetIntFromObj(interp, objPtr, sizePtr); +#else + Tcl_WideInt wide; + if (TclGetWideIntFromObj(interp, objPtr, &wide) != TCL_OK) { + return TCL_ERROR; + } + *sizePtr = (Tcl_Size)wide; + return TCL_OK; +#endif +} + + /* *---------------------------------------------------------------------- * @@ -4595,11 +4640,12 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token) #endif +/* TODO - code below does not check for integer overflow */ #define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ do { \ - size_t _needed = (used) + (append); \ + Tcl_Size _needed = (used) + (append); \ if (_needed > (available)) { \ - size_t allocated = 2 * _needed; \ + Tcl_Size allocated = 2 * _needed; \ Tcl_Token *oldPtr = (tokenPtr); \ Tcl_Token *newPtr; \ if (oldPtr == (staticPtr)) { \ @@ -4657,16 +4703,17 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; * of counting along a string of all one-byte characters. The ANSI C * "prototype" for this macro is: * - * MODULE_SCOPE void TclNumUtfCharsM(int numChars, const char *bytes, - * int numBytes); + * MODULE_SCOPE void TclNumUtfCharsM(Tcl_Size numChars, const char *bytes, + * Tcl_Size numBytes); + * numBytes must be >= 0 *---------------------------------------------------------------- */ #define TclNumUtfCharsM(numChars, bytes, numBytes) \ do { \ - size_t _count, _i = (numBytes); \ + Tcl_Size _count = 0, _i = (numBytes); \ unsigned char *_str = (unsigned char *) (bytes); \ - while (_i && (*_str < 0xC0)) { _i--; _str++; } \ + while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ _count = (numBytes) - _i; \ if (_i) { \ _count += Tcl_NumUtfChars((bytes) + _count, _i); \ @@ -4846,27 +4893,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; } while (0) #define TclNewIndexObj(objPtr, uw) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ >= TCL_INDEX_NONE) { \ - (objPtr)->internalRep.wideValue = -1; \ - (objPtr)->typePtr = &tclIntType.objType; \ - } else if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ - Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \ - } \ - TclSetBignumInternalRep((objPtr), &bignumValue_); \ - } else { \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \ - (objPtr)->typePtr = &tclIntType.objType; \ - } \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ - } while (0) + TclNewIntObj(objPtr, uw) #define TclNewDoubleObj(objPtr, d) \ do { \ @@ -4909,14 +4936,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; } while (0) #define TclNewIndexObj(objPtr, w) \ - do { \ - Tcl_WideUInt _uw = (Tcl_WideUInt)(w); \ - if (_uw >= TCL_INDEX_NONE) { \ - TclNewIntObj(objPtr, -1); \ - } else { \ - TclNewUIntObj(objPtr, _uw); \ - } \ - } while (0) + TclNewIntObj(objPtr, w) #define TclNewDoubleObj(objPtr, d) \ (objPtr) = Tcl_NewDoubleObj(d) @@ -5191,7 +5211,7 @@ MODULE_SCOPE size_t TclEnvEpoch; /* Epoch of the tcl environment * (if changed with tcl-env). */ #endif /* _TCLINT */ - + /* * Local Variables: * mode: c diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index d6168b5de12a..46479fb22584 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -309,7 +309,7 @@ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 143 */ -EXTERN Tcl_Size TclAddLiteralObj(struct CompileEnv *envPtr, +EXTERN int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 144 */ EXTERN void TclHideLiteral(Tcl_Interp *interp, @@ -544,7 +544,7 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, EXTERN void TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force); /* 251 */ -EXTERN Tcl_Size TclRegisterLiteral(void *envPtr, const char *bytes, +EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes, Tcl_Size length, int flags); /* 252 */ EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr, @@ -731,7 +731,7 @@ typedef struct TclIntStubs { void (*reserved140)(void); const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */ - Tcl_Size (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ + int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */ TclHandle (*tclHandleCreate) (void *ptr); /* 146 */ @@ -839,7 +839,7 @@ typedef struct TclIntStubs { int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ - Tcl_Size (*tclRegisterLiteral) (void *envPtr, const char *bytes, Tcl_Size length, int flags); /* 251 */ + int (*tclRegisterLiteral) (void *envPtr, const char *bytes, Tcl_Size length, int flags); /* 251 */ Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 252 */ Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 253 */ Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags); /* 254 */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index ecc6e15ae13c..aaa229146fb0 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -60,7 +60,7 @@ typedef struct { Tcl_Obj *objPtr; /* The first actual prefix object - the target * command name; this has to be at the end of * the structure, which will be extended to - * accomodate the remaining objects in the + * accommodate the remaining objects in the * prefix. */ } Alias; @@ -197,7 +197,7 @@ struct LimitHandler { /* * Values for the LimitHandler flags field. * LIMIT_HANDLER_ACTIVE - Whether the handler is currently being - * processed; handlers are never to be entered reentrantly. + * processed; handlers are never to be reentered. * LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This * should not normally be observed because when a handler is * deleted it is also spliced out of the list of handlers, but @@ -832,12 +832,12 @@ NRInterpCmd( for (i = 0; ; i++) { Tcl_CmdInfo cmdInfo; - sprintf(buf, "interp%d", i); + snprintf(buf, sizeof(buf), "interp%d", i); if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) { break; } } - childPtr = Tcl_NewStringObj(buf, TCL_INDEX_NONE); + childPtr = Tcl_NewStringObj(buf, -1); } if (ChildCreate(interp, childPtr, safe) == NULL) { if (buf[0] != '\0') { @@ -872,7 +872,7 @@ NRInterpCmd( return TCL_ERROR; } else if (childInterp == interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot delete the current interpreter", TCL_INDEX_NONE)); + "cannot delete the current interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "DELETESELF", NULL); return TCL_ERROR; @@ -1053,7 +1053,7 @@ NRInterpCmd( for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { string = (char *)Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr); Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewStringObj(string, TCL_INDEX_NONE)); + Tcl_NewStringObj(string, -1)); } Tcl_SetObjResult(interp, resultPtr); return TCL_OK; @@ -1197,24 +1197,24 @@ Tcl_CreateAlias( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - size_t argc, /* How many additional arguments? */ + Tcl_Size argc, /* How many additional arguments? */ const char *const *argv) /* These are the additional args. */ { Tcl_Obj *childObjPtr, *targetObjPtr; Tcl_Obj **objv; - size_t i; + Tcl_Size i; int result; objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc); for (i = 0; i < argc; i++) { - objv[i] = Tcl_NewStringObj(argv[i], TCL_INDEX_NONE); + objv[i] = Tcl_NewStringObj(argv[i], -1); Tcl_IncrRefCount(objv[i]); } - childObjPtr = Tcl_NewStringObj(childCmd, TCL_INDEX_NONE); + childObjPtr = Tcl_NewStringObj(childCmd, -1); Tcl_IncrRefCount(childObjPtr); - targetObjPtr = Tcl_NewStringObj(targetCmd, TCL_INDEX_NONE); + targetObjPtr = Tcl_NewStringObj(targetCmd, -1); Tcl_IncrRefCount(targetObjPtr); result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr, @@ -1252,16 +1252,16 @@ Tcl_CreateAliasObj( const char *childCmd, /* Command to install in child. */ Tcl_Interp *targetInterp, /* Interpreter for target command. */ const char *targetCmd, /* Name of target command. */ - size_t objc, /* How many additional arguments? */ + Tcl_Size objc, /* How many additional arguments? */ Tcl_Obj *const objv[]) /* Argument vector. */ { Tcl_Obj *childObjPtr, *targetObjPtr; int result; - childObjPtr = Tcl_NewStringObj(childCmd, TCL_INDEX_NONE); + childObjPtr = Tcl_NewStringObj(childCmd, -1); Tcl_IncrRefCount(childObjPtr); - targetObjPtr = Tcl_NewStringObj(targetCmd, TCL_INDEX_NONE); + targetObjPtr = Tcl_NewStringObj(targetCmd, -1); Tcl_IncrRefCount(targetObjPtr); result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr, @@ -2116,7 +2116,7 @@ Tcl_CreateChild( Tcl_Obj *pathPtr; Tcl_Interp *childInterp; - pathPtr = Tcl_NewStringObj(childPath, TCL_INDEX_NONE); + pathPtr = Tcl_NewStringObj(childPath, -1); childInterp = ChildCreate(interp, pathPtr, isSafe); Tcl_DecrRefCount(pathPtr); @@ -2147,7 +2147,7 @@ Tcl_GetChild( Tcl_Obj *pathPtr; Tcl_Interp *childInterp; - pathPtr = Tcl_NewStringObj(childPath, TCL_INDEX_NONE); + pathPtr = Tcl_NewStringObj(childPath, -1); childInterp = GetInterp(interp, pathPtr); Tcl_DecrRefCount(pathPtr); @@ -2293,7 +2293,7 @@ Tcl_GetInterpPath( } Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->parent.childTable, - iiPtr->child.childEntryPtr), TCL_INDEX_NONE)); + iiPtr->child.childEntryPtr), -1)); return TCL_OK; } @@ -2323,7 +2323,7 @@ GetInterp( Tcl_HashEntry *hPtr; /* Search element. */ Child *childPtr; /* Interim child record. */ Tcl_Obj **objv; - size_t objc, i; + Tcl_Size objc, i; Tcl_Interp *searchInterp; /* Interim storage for interp. to find. */ InterpInfo *parentInfoPtr; @@ -2381,12 +2381,12 @@ ChildBgerror( Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { - size_t length; + Tcl_Size length; if (TCL_ERROR == TclListObjLengthM(NULL, objv[0], &length) || (length < 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cmdPrefix must be list of length >= 1", TCL_INDEX_NONE)); + "cmdPrefix must be list of length >= 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BGERRORFORMAT", NULL); return TCL_ERROR; @@ -2428,7 +2428,7 @@ ChildCreate( Tcl_HashEntry *hPtr; const char *path; int isNew; - size_t objc; + Tcl_Size objc; Tcl_Obj **objv; if (TclListObjGetElementsM(interp, pathPtr, &objc, &objv) != TCL_OK) { @@ -2831,7 +2831,7 @@ ChildDebugCmd( if (objc == 0) { TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, - Tcl_NewStringObj("-frame", TCL_INDEX_NONE)); + Tcl_NewStringObj("-frame", -1)); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME)); Tcl_SetObjResult(interp, resultPtr); @@ -3001,7 +3001,7 @@ ChildRecursionLimit( if (objc) { if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: " - "safe interpreters cannot change recursion limit", TCL_INDEX_NONE)); + "safe interpreters cannot change recursion limit", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE", NULL); return TCL_ERROR; @@ -3009,18 +3009,18 @@ ChildRecursionLimit( if (TclGetWideIntFromObj(interp, objv[0], &limit) == TCL_ERROR) { return TCL_ERROR; } - if (limit <= 0 || (size_t)limit >= ((Tcl_WideUInt)WIDE_MAX & TCL_INDEX_NONE)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "recursion limit must be > 0 and < %" TCL_LL_MODIFIER "u", (Tcl_WideUInt)WIDE_MAX & TCL_INDEX_NONE)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", - NULL); + if (limit <= 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "recursion limit must be > 0", -1)); + Tcl_SetErrorCode( + interp, "TCL", "OPERATION", "INTERP", "BADLIMIT", NULL); return TCL_ERROR; } Tcl_SetRecursionLimit(childInterp, limit); iPtr = (Interp *) childInterp; - if (interp == childInterp && iPtr->numLevels > (size_t)limit) { + if (interp == childInterp && iPtr->numLevels > limit) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "falling back due to new recursion limit", TCL_INDEX_NONE)); + "falling back due to new recursion limit", -1)); Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL); return TCL_ERROR; } @@ -3110,7 +3110,7 @@ ChildHidden( hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { Tcl_ListObjAppendElement(NULL, listObjPtr, - Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), TCL_INDEX_NONE)); + Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), -1)); } } Tcl_SetObjResult(interp, listObjPtr); @@ -3325,7 +3325,7 @@ TclMakeSafe( Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY); /* - * Unset path informations variables (the only one remaining is [info + * Unset path information variables (the only one remaining is [info * nameofexecutable]) */ @@ -3479,7 +3479,7 @@ Tcl_LimitCheck( iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS; } else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command count limit exceeded", TCL_INDEX_NONE)); + "command count limit exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL); Tcl_Release(interp); return TCL_ERROR; @@ -3505,7 +3505,7 @@ Tcl_LimitCheck( iPtr->limit.exceeded &= ~TCL_LIMIT_TIME; } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "time limit exceeded", TCL_INDEX_NONE)); + "time limit exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL); Tcl_Release(interp); return TCL_ERROR; @@ -3985,7 +3985,7 @@ Tcl_LimitTypeReset( void Tcl_LimitSetCommands( Tcl_Interp *interp, - size_t commandLimit) + Tcl_Size commandLimit) { Interp *iPtr = (Interp *) interp; @@ -4289,7 +4289,7 @@ CallScriptLimitCallback( * None. * * Side effects: - * A limit callback implemented as an invokation of a Tcl script in + * A limit callback implemented as an invocation of a Tcl script in * another interpreter is either installed or removed. * *---------------------------------------------------------------------- @@ -4508,7 +4508,7 @@ ChildCommandLimitCmd( if (interp == childInterp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "limits on current interpreter inaccessible", TCL_INDEX_NONE)); + "limits on current interpreter inaccessible", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL); return TCL_ERROR; } @@ -4523,7 +4523,7 @@ ChildCommandLimitCmd( if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; @@ -4534,21 +4534,21 @@ ChildCommandLimitCmd( putEmptyCommandInDict: TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[0], TCL_INDEX_NONE), empty); + Tcl_NewStringObj(options[0], -1), empty); } - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1), Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS))); if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) { - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp))); } else { Tcl_Obj *empty; TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[2], TCL_INDEX_NONE), empty); + Tcl_NewStringObj(options[2], -1), empty); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -4586,7 +4586,7 @@ ChildCommandLimitCmd( return TCL_ERROR; } else { int i; - size_t scriptLen = 0, limitLen = 0; + Tcl_Size scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; @@ -4607,7 +4607,7 @@ ChildCommandLimitCmd( } if (gran < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "granularity must be at least 1", TCL_INDEX_NONE)); + "granularity must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; @@ -4624,7 +4624,7 @@ ChildCommandLimitCmd( } if (limit < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "command limit value must be at least 0", TCL_INDEX_NONE)); + "command limit value must be at least 0", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; @@ -4696,7 +4696,7 @@ ChildTimeLimitCmd( if (interp == childInterp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "limits on current interpreter inaccessible", TCL_INDEX_NONE)); + "limits on current interpreter inaccessible", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL); return TCL_ERROR; } @@ -4711,7 +4711,7 @@ ChildTimeLimitCmd( if (hPtr != NULL) { limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr); if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) { - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1), limitCBPtr->scriptObj); } else { goto putEmptyCommandInDict; @@ -4721,9 +4721,9 @@ ChildTimeLimitCmd( putEmptyCommandInDict: TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[0], TCL_INDEX_NONE), empty); + Tcl_NewStringObj(options[0], -1), empty); } - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1), Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME))); @@ -4731,18 +4731,18 @@ ChildTimeLimitCmd( Tcl_Time limitMoment; Tcl_LimitGetTime(childInterp, &limitMoment); - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1), Tcl_NewWideIntObj(limitMoment.usec/1000)); - Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], TCL_INDEX_NONE), + Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1), Tcl_NewWideIntObj(limitMoment.sec)); } else { Tcl_Obj *empty; TclNewObj(empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[2], TCL_INDEX_NONE), empty); + Tcl_NewStringObj(options[2], -1), empty); Tcl_DictObjPut(NULL, dictPtr, - Tcl_NewStringObj(options[3], TCL_INDEX_NONE), empty); + Tcl_NewStringObj(options[3], -1), empty); } Tcl_SetObjResult(interp, dictPtr); return TCL_OK; @@ -4791,7 +4791,7 @@ ChildTimeLimitCmd( return TCL_ERROR; } else { int i; - size_t scriptLen = 0, milliLen = 0, secLen = 0; + Tcl_Size scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; @@ -4816,7 +4816,7 @@ ChildTimeLimitCmd( } if (gran < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "granularity must be at least 1", TCL_INDEX_NONE)); + "granularity must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADVALUE", NULL); return TCL_ERROR; @@ -4870,7 +4870,7 @@ ChildTimeLimitCmd( if (secObj != NULL && secLen == 0 && milliLen > 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may only set -milliseconds if -seconds is not " - "also being reset", TCL_INDEX_NONE)); + "also being reset", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", NULL); return TCL_ERROR; @@ -4878,7 +4878,7 @@ ChildTimeLimitCmd( if (milliLen == 0 && (secObj == NULL || secLen > 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may only reset -milliseconds if -seconds is " - "also being reset", TCL_INDEX_NONE)); + "also being reset", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADUSAGE", NULL); return TCL_ERROR; diff --git a/generic/tclLink.c b/generic/tclLink.c index eec778a81f03..7474769e9f48 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -33,10 +33,10 @@ typedef struct { * actual variable may be aliased at that time * via upvar. */ void *addr; /* Location of C variable. */ - size_t bytes; /* Size of C variable array. This is 0 when + Tcl_Size bytes; /* Size of C variable array. This is 0 when * single variables, and >0 used for array * variables. */ - size_t numElems; /* Number of elements in C variable array. + Tcl_Size numElems; /* Number of elements in C variable array. * Zero for single variables. */ int type; /* Type of link (TCL_LINK_INT, etc.). */ union { @@ -175,7 +175,7 @@ Tcl_LinkVar( linkPtr = (Link *)Tcl_Alloc(sizeof(Link)); linkPtr->interp = interp; linkPtr->nsPtr = NULL; - linkPtr->varName = Tcl_NewStringObj(varName, TCL_INDEX_NONE); + linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); linkPtr->addr = addr; linkPtr->type = type & ~TCL_LINK_READ_ONLY; @@ -246,7 +246,7 @@ Tcl_LinkArray( * interpreter result. */ int type, /* Type of C variable: TCL_LINK_INT, etc. Also * may have TCL_LINK_READ_ONLY OR'ed in. */ - size_t size) /* Size of C variable array, >1 if array */ + Tcl_Size size) /* Size of C variable array, >1 if array */ { Tcl_Obj *objPtr; Link *linkPtr; @@ -256,7 +256,7 @@ Tcl_LinkArray( if (size < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "wrong array size given", TCL_INDEX_NONE)); + "wrong array size given", -1)); return TCL_ERROR; } @@ -340,7 +340,7 @@ Tcl_LinkArray( default: LinkFree(linkPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad linked array variable type", TCL_INDEX_NONE)); + "bad linked array variable type", -1)); return TCL_ERROR; } @@ -380,7 +380,7 @@ Tcl_LinkArray( */ linkPtr->interp = interp; - linkPtr->varName = Tcl_NewStringObj(varName, TCL_INDEX_NONE); + linkPtr->varName = Tcl_NewStringObj(varName, -1); Tcl_IncrRefCount(linkPtr->varName); TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY, @@ -592,7 +592,7 @@ SetInvalidRealFromAny( { const char *str; const char *endPtr; - size_t length; + Tcl_Size length; str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 1) && (str[0] == '.')) { @@ -638,7 +638,7 @@ GetInvalidIntFromObj( Tcl_Obj *objPtr, int *intPtr) { - size_t length; + Tcl_Size length; const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || ((length == 2) && (str[0] == '0') @@ -715,7 +715,7 @@ LinkTraceProc( { Link *linkPtr = (Link *)clientData; int changed; - size_t valueLength = 0; + Tcl_Size valueLength = 0; const char *value; char **pp; Tcl_Obj *valueObj; @@ -723,7 +723,7 @@ LinkTraceProc( Tcl_WideInt valueWide; Tcl_WideUInt valueUWide; double valueDouble; - size_t objc, i; + Tcl_Size objc, i; Tcl_Obj **objv; /* @@ -830,7 +830,7 @@ LinkTraceProc( /* * For writes, first make sure that the variable is writable. Then convert * the Tcl value to C if possible. If the variable isn't writable or can't - * be converted, then restore the varaible's old value and return an + * be converted, then restore the variable's old value and return an * error. Another tricky thing: we have to save and restore the interp's * result, since the variable access could occur when the result has been * partially set. @@ -1249,7 +1249,7 @@ ObjValue( { char *p; Tcl_Obj *resultObj, **objv; - size_t i; + Tcl_Size i; switch (linkPtr->type) { case TCL_LINK_INT: @@ -1433,7 +1433,7 @@ ObjValue( TclNewLiteralStringObj(resultObj, "NULL"); return resultObj; } - return Tcl_NewStringObj(p, TCL_INDEX_NONE); + return Tcl_NewStringObj(p, -1); case TCL_LINK_CHARS: if (linkPtr->flags & LINK_ALLOC_LAST) { diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 7cf96cb743fb..87530be3491e 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -50,13 +50,13 @@ #define LIST_INDEX_ASSERT(idxarg_) \ do { \ Tcl_Size idx_ = (idxarg_); /* To guard against ++ etc. */ \ - LIST_ASSERT(idx_ != TCL_INDEX_NONE && idx_ < LIST_MAX); \ + LIST_ASSERT(idx_ >= 0 && idx_ < LIST_MAX); \ } while (0) /* Ditto for counts except upper limit is different */ #define LIST_COUNT_ASSERT(countarg_) \ do { \ Tcl_Size count_ = (countarg_); /* To guard against ++ etc. */ \ - LIST_ASSERT(count_ != TCL_INDEX_NONE && count_ <= LIST_MAX); \ + LIST_ASSERT(count_ >= 0 && count_ <= LIST_MAX); \ } while (0) #else @@ -143,7 +143,7 @@ static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeListInternalRep(Tcl_Obj *listPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfList(Tcl_Obj *listPtr); -static size_t ListLength(Tcl_Obj *listPtr); +static Tcl_Size ListLength(Tcl_Obj *listPtr); /* * The structure below defines the list Tcl object type by means of functions @@ -526,7 +526,7 @@ ListLimitExceededError(Tcl_Interp *interp) if (interp != NULL) { Tcl_SetObjResult( interp, - Tcl_NewStringObj("max length of a Tcl list exceeded", TCL_INDEX_NONE)); + Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; @@ -850,7 +850,19 @@ ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots) newCapacity = ListStoreUpSize(numSlots); newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); + + /* + * In case above failed keep looping reducing the requested extra space + * by half every time. + */ + while (newStorePtr == NULL && (newCapacity > (numSlots+1))) { + /* Because of loop condition newCapacity can't overflow */ + newCapacity = numSlots + ((newCapacity - numSlots) / 2); + newStorePtr = + (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); + } if (newStorePtr == NULL) { + /* Last resort - allcate what was asked */ newCapacity = numSlots; newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity)); @@ -1436,13 +1448,13 @@ ListRepRange( ListRepFreeUnreferenced(srcRepPtr); } /* else T:listrep-2.{4.2,4.3,5.2,5.3,6.2,7.2,8.1} */ - if (rangeStart == TCL_INDEX_NONE) { + if (rangeStart < 0) { rangeStart = 0; } - if ((rangeEnd != TCL_INDEX_NONE) && (rangeEnd >= numSrcElems)) { + if (rangeEnd >= numSrcElems) { rangeEnd = numSrcElems - 1; } - if (rangeStart + 1 > rangeEnd + 1) { + if (rangeStart > rangeEnd) { /* Empty list of capacity 1. */ ListRepInit(1, NULL, LISTREP_PANIC_ON_FAIL, rangeRepPtr); return; @@ -1601,6 +1613,7 @@ ListRepRange( Tcl_Obj * TclListObjRange( + Tcl_Interp *interp, /* May be NULL. Used for error messages */ Tcl_Obj *listObj, /* List object to take a range from. */ Tcl_Size rangeStart, /* Index of first element to include. */ Tcl_Size rangeEnd) /* Index of last element to include. */ @@ -1609,7 +1622,7 @@ TclListObjRange( ListRep resultRep; int isShared; - if (TclListObjGetRep(NULL, listObj, &listRep) != TCL_OK) + if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) return NULL; isShared = Tcl_IsShared(listObj); @@ -1764,7 +1777,7 @@ Tcl_ListObjAppendList( if (TclListObjGetRep(interp, toObj, &listRep) != TCL_OK) return TCL_ERROR; /* Cannot be converted to a list */ - if (elemCount == 0) + if (elemCount <= 0) return TCL_OK; /* Nothing to do. Note AFTER check for list above */ ListRepElements(&listRep, toLen, toObjv); @@ -1852,7 +1865,7 @@ Tcl_ListObjAppendList( : LISTREP_SPACE_ONLY_BACK, &listRep) != TCL_OK) { - return TCL_ERROR; + return MemoryAllocationError(interp, finalLen); } LIST_ASSERT(listRep.storePtr->numAllocated >= finalLen); @@ -1877,24 +1890,27 @@ Tcl_ListObjAppendList( * * Tcl_ListObjAppendElement -- * - * This function is a special purpose version of Tcl_ListObjAppendList: - * it appends a single object referenced by elemObj to the list object - * referenced by toObj. If toObj is not already a list object, an - * attempt will be made to convert it to one. + * Like 'Tcl_ListObjAppendList', but Appends a single value to a list. * - * Results: - * The return value is normally TCL_OK; in this case elemObj is added to - * the end of toObj's list. If toObj does not refer to a list object - * and the object can not be converted to one, TCL_ERROR is returned and - * an error message will be left in the interpreter's result if interp is - * not NULL. + * Value * - * Side effects: - * The ref count of elemObj is incremented since the list now refers to - * it. toObj will be converted, if necessary, to a list object. Also, - * appending the new element may cause listObj's array of element - * pointers to grow. toObj's old string representation, if any, is - * invalidated. + * TCL_OK + * + * 'objPtr' is appended to the elements of 'listPtr'. + * + * TCL_ERROR + * + * listPtr does not refer to a list object and the object can not be + * converted to one. An error message will be left in the + * interpreter's result if interp is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. + * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'. + * Appending the new element may cause the array of element pointers + * in 'listObj' to grow. Any preexisting string representation of + * 'listPtr' is invalidated. * *---------------------------------------------------------------------- */ @@ -1916,23 +1932,27 @@ Tcl_ListObjAppendElement( * * Tcl_ListObjIndex -- * - * This function returns a pointer to the index'th object from the list - * referenced by listPtr. The first element has index 0. If index is - * negative or greater than or equal to the number of elements in the - * list, a NULL is returned. If listPtr is not a list object, an attempt - * will be made to convert it to a list. + * Retrieve a pointer to the element of 'listPtr' at 'index'. The index + * of the first element is 0. * - * Results: - * The return value is normally TCL_OK; in this case objPtrPtr is set to - * the Tcl_Obj pointer for the index'th list element or NULL if index is - * out of range. This object should be treated as readonly and its ref - * count is _not_ incremented; the caller must do that if it holds on to - * the reference. If listPtr does not refer to a list and can't be - * converted to one, TCL_ERROR is returned and an error message is left - * in the interpreter's result if interp is not NULL. + * Value * - * Side effects: - * listPtr will be converted, if necessary, to a list object. + * TCL_OK + * + * A pointer to the element at 'index' is stored in 'objPtrPtr'. If + * 'index' is out of range, NULL is stored in 'objPtrPtr'. This + * object should be treated as readonly and its 'refCount' is _not_ + * incremented. The caller must do that if it holds on to the + * reference. + * + * TCL_ERROR + * + * 'listPtr' is not a valid list. An error message is left in the + * interpreter's result if 'interp' is not NULL. + * + * Effect + * + * If 'listPtr' is not already of type 'tclListType', it is converted. * *---------------------------------------------------------------------- */ @@ -1957,7 +1977,7 @@ Tcl_ListObjIndex( != TCL_OK) { return TCL_ERROR; } - if (index >= numElems) { + if (index < 0 || index >= numElems) { *objPtrPtr = NULL; } else { *objPtrPtr = elemObjs[index]; @@ -1997,7 +2017,7 @@ Tcl_ListObjLength( { ListRep listRep; - size_t (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc); + Tcl_Size (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc); if (lengthProc) { *lenPtr = lengthProc(listObj); return TCL_OK; @@ -2017,11 +2037,11 @@ Tcl_ListObjLength( return TCL_OK; } -size_t ListLength( - Tcl_Obj *listPtr) +Tcl_Size +ListLength(Tcl_Obj *listPtr) { - ListRep listRep; - ListObjGetRep(listPtr, &listRep); + ListRep listRep; + ListObjGetRep(listPtr, &listRep); return ListRepLength(&listRep); } @@ -2094,20 +2114,20 @@ Tcl_ListObjReplace( /* Make limits sane */ origListLen = ListRepLength(&listRep); - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = 0; } if (first > origListLen) { first = origListLen; /* So we'll insert after last element. */ } - if (numToDelete == TCL_INDEX_NONE) { + if (numToDelete < 0) { numToDelete = 0; - } else if (first > ListSizeT_MAX - numToDelete /* Handle integer overflow */ + } else if (first > LIST_MAX - numToDelete /* Handle integer overflow */ || origListLen < first + numToDelete) { numToDelete = origListLen - first; } - if (numToInsert > ListSizeT_MAX - (origListLen - numToDelete)) { + if (numToInsert > LIST_MAX - (origListLen - numToDelete)) { return ListLimitExceededError(interp); } @@ -2344,7 +2364,7 @@ Tcl_ListObjReplace( */ /* - * Calculate shifts if necessary to accomodate insertions. + * Calculate shifts if necessary to accommodate insertions. * NOTE: all indices are relative to listObjs which is not necessarily the * start of the ListStore storage area. * @@ -2568,7 +2588,7 @@ TclLindexList( * see TIP#22 and TIP#33 for the details. */ if (!TclHasInternalRep(argObj, &tclListType.objType) - && TclGetIntForIndexM(NULL, argObj, ListSizeT_MAX - 1, &index) + && TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index) == TCL_OK) { /* * argPtr designates a single index. @@ -2633,7 +2653,7 @@ Tcl_Obj * TclLindexFlat( Tcl_Interp *interp, /* Tcl interpreter. */ Tcl_Obj *listObj, /* Tcl object representing the list. */ - Tcl_Size indexCount, /* Count of indices. */ + Tcl_Size indexCount, /* Count of indices. */ Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that * represent the indices in the list. */ { @@ -2686,7 +2706,7 @@ TclLindexFlat( if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, &index) == TCL_OK) { - if (index >= listLen) { + if (index < 0 || index >= listLen) { /* * Index is out of range. Break out of loop with empty result. * First check remaining indices for validity @@ -2694,7 +2714,7 @@ TclLindexFlat( while (++i < indexCount) { if (TclGetIntForIndexM( - interp, indexArray[i], ListSizeT_MAX - 1, &index) + interp, indexArray[i], TCL_SIZE_MAX - 1, &index) != TCL_OK) { Tcl_DecrRefCount(sublistCopy); return NULL; @@ -2759,7 +2779,7 @@ TclLsetList( */ if (!TclHasInternalRep(indexArgObj, &tclListType.objType) - && TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index) + && TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index) == TCL_OK) { /* indexArgPtr designates a single index. */ /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */ @@ -2778,7 +2798,7 @@ TclLsetList( ListObjGetElements(indexListCopy, indexCount, indices); /* - * Let TclLsetFlat handle the actual lset'ting. + * Let TclLsetFlat perform the actual lset operation. */ retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj); @@ -2914,7 +2934,7 @@ TclLsetFlat( } indexArray++; - if (index > elemCount + if (index < 0 || index > elemCount || (valueObj == NULL && index >= elemCount)) { /* ...the index points outside the sublist. */ if (interp != NULL) { @@ -3407,18 +3427,16 @@ SetListFromAny( * * UpdateStringOfList -- * - * Update the string representation for a list object. Note: This - * function does not invalidate an existing old string rep so storage - * will be lost if this has not already been done. + * Update the string representation for a list object. * - * Results: - * None. + * Any previously-existing string representation is not invalidated, so + * storage is lost if this has not been taken care of. * - * Side effects: - * The object's string is set to a valid string that results from the - * list-to-string conversion. This string will be empty if the list has - * no elements. The list internal representation should not be NULL and - * we assume it is not NULL. + * Effect + * + * The string representation of 'listPtr' is set to the resulting string. + * This string will be empty if the list has no elements. It is assumed + * that the list internal representation is not NULL. * *---------------------------------------------------------------------- */ diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index c3f0f7d2fb67..9051b45e7c29 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -178,9 +178,9 @@ TclCreateLiteral( Interp *iPtr, const char *bytes, /* The start of the string. Note that this is * not a NUL-terminated string. */ - size_t length, /* Number of bytes in the string. */ - size_t hash, /* The string's hash. If the value is - * TCL_INDEX_NONE, it will be computed here. */ + Tcl_Size length, /* Number of bytes in the string. */ + TCL_HASH_TYPE hash, /* The string's hash. If the value is + * TCL_INDEX_NONE, it will be computed here. */ int *newPtr, Namespace *nsPtr, int flags, @@ -195,7 +195,7 @@ TclCreateLiteral( * Is it in the interpreter's global literal table? */ - if (hash == TCL_INDEX_NONE) { + if (hash == (TCL_HASH_TYPE) TCL_INDEX_NONE) { hash = HashString(bytes, length); } globalHash = (hash & globalTablePtr->mask); @@ -210,7 +210,7 @@ TclCreateLiteral( * https://stackoverflow.com/q/54337750/301832 */ - size_t objLength; + Tcl_Size objLength; const char *objBytes = Tcl_GetStringFromObj(objPtr, &objLength); if ((objLength == length) && ((length == 0) @@ -351,7 +351,7 @@ Tcl_Obj * TclFetchLiteral( CompileEnv *envPtr, /* Points to the CompileEnv from which to * fetch the registered literal value. */ - size_t index) /* Index of the desired literal, as returned + Tcl_Size index) /* Index of the desired literal, as returned * by prior call to TclRegisterLiteral() */ { if (index >= envPtr->literalArrayNext) { @@ -387,20 +387,20 @@ TclFetchLiteral( *---------------------------------------------------------------------- */ -size_t +int /* Do NOT change this type. Should not be wider than TclEmitPush operand*/ TclRegisterLiteral( void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ const char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object * array. */ - size_t length, /* Number of bytes in the string. If -1, the + Tcl_Size length, /* Number of bytes in the string. If -1, the * string consists of all bytes up to the * first null character. */ int flags) /* If LITERAL_ON_HEAP then the caller already * malloc'd bytes and ownership is passed to * this function. If LITERAL_CMD_NAME then - * the literal should not be shared accross + * the literal should not be shared across * namespaces. */ { CompileEnv *envPtr = (CompileEnv *)ePtr; @@ -412,7 +412,7 @@ TclRegisterLiteral( int isNew; Namespace *nsPtr; - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = (bytes ? strlen(bytes) : 0); } hash = HashString(bytes, length); @@ -437,13 +437,16 @@ TclRegisterLiteral( TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ + if (objIndex > INT_MAX) { + Tcl_Panic("Literal table index too large. Cannot be handled by TclEmitPush"); + } return objIndex; } } /* * The literal is new to this CompileEnv. If it is a command name, avoid - * sharing it accross namespaces, and try not to share it with non-cmd + * sharing it across namespaces, and try not to share it with non-cmd * literals. Note that FQ command names can be shared, so that we register * the namespace as the interp's global NS. */ @@ -475,6 +478,10 @@ TclRegisterLiteral( } TclVerifyLocalLiteralTable(envPtr); #endif /*TCL_COMPILE_DEBUG*/ + if (objIndex > INT_MAX) { + Tcl_Panic( + "Literal table index too large. Cannot be handled by TclEmitPush"); + } return objIndex; } @@ -553,7 +560,8 @@ TclHideLiteral( { LiteralEntry **nextPtrPtr, *entryPtr, *lPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; - size_t localHash, length; + size_t localHash; + Tcl_Size length; const char *bytes; Tcl_Obj *newObjPtr; @@ -607,7 +615,7 @@ TclHideLiteral( *---------------------------------------------------------------------- */ -size_t +int TclAddLiteralObj( CompileEnv *envPtr,/* Points to CompileEnv in whose literal array * the object is to be inserted. */ @@ -624,6 +632,10 @@ TclAddLiteralObj( } objIndex = envPtr->literalArrayNext; envPtr->literalArrayNext++; + if (objIndex > INT_MAX) { + Tcl_Panic( + "Literal table index too large. Cannot be handled by TclEmitPush"); + } lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; @@ -826,7 +838,8 @@ TclReleaseLiteral( LiteralTable *globalTablePtr; LiteralEntry *entryPtr, *prevPtr; const char *bytes; - size_t length, index; + size_t index; + Tcl_Size length; if (iPtr == NULL) { goto done; @@ -969,7 +982,8 @@ RebuildLiteralTable( LiteralEntry *entryPtr; LiteralEntry **bucketPtr; const char *bytes; - size_t oldSize, count, index, length; + size_t oldSize, count, index; + Tcl_Size length; oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; @@ -1128,18 +1142,18 @@ TclLiteralStats( */ result = (char *)Tcl_Alloc(NUM_COUNTERS*60 + 300); - sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", + snprintf(result, 60, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; iprefix, TCL_INDEX_NONE); + Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; @@ -307,10 +307,10 @@ Tcl_LoadObjCmd( */ if (prefix != NULL) { - Tcl_DStringAppend(&pfx, prefix, TCL_INDEX_NONE); + Tcl_DStringAppend(&pfx, prefix, -1); } else { Tcl_Obj *splitPtr, *pkgGuessPtr; - size_t pElements; + Tcl_Size pElements; const char *pkgGuess; /* @@ -487,7 +487,7 @@ Tcl_LoadObjCmd( * 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, TCL_INDEX_NONE)); + Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1)); iPtr->legacyResult = NULL; iPtr->legacyFreeProc = (void (*) (void))-1; } @@ -625,7 +625,7 @@ Tcl_UnloadObjCmd( } if ((fullFileName[0] == 0) && (prefix == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "must specify either file name or prefix", TCL_INDEX_NONE)); + "must specify either file name or prefix", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY", NULL); code = TCL_ERROR; @@ -665,9 +665,9 @@ Tcl_UnloadObjCmd( namesMatch = 0; } else { TclDStringClear(&pfx); - Tcl_DStringAppend(&pfx, prefix, TCL_INDEX_NONE); + Tcl_DStringAppend(&pfx, prefix, -1); TclDStringClear(&tmp); - Tcl_DStringAppend(&tmp, libraryPtr->prefix, TCL_INDEX_NONE); + Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1); if (strcmp(Tcl_DStringValue(&tmp), Tcl_DStringValue(&pfx)) == 0) { namesMatch = 1; @@ -1121,8 +1121,8 @@ TclGetLoadedLibraries( Tcl_MutexLock(&libraryMutex); for (libraryPtr = firstLibraryPtr; libraryPtr != NULL; libraryPtr = libraryPtr->nextPtr) { - pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, TCL_INDEX_NONE); - pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, TCL_INDEX_NONE); + pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1); + pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc)); } @@ -1147,7 +1147,7 @@ TclGetLoadedLibraries( libraryPtr = ipPtr->libraryPtr; if (!strcmp(prefix, libraryPtr->prefix)) { - resultObj = Tcl_NewStringObj(libraryPtr->fileName, TCL_INDEX_NONE); + resultObj = Tcl_NewStringObj(libraryPtr->fileName, -1); break; } } @@ -1166,8 +1166,8 @@ TclGetLoadedLibraries( TclNewObj(resultObj); for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) { libraryPtr = ipPtr->libraryPtr; - pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, TCL_INDEX_NONE); - pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, TCL_INDEX_NONE); + pkgDesc[0] = Tcl_NewStringObj(libraryPtr->fileName, -1); + pkgDesc[1] = Tcl_NewStringObj(libraryPtr->prefix, -1); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc)); } Tcl_SetObjResult(interp, resultObj); diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c index abf6edae50de..f60f843b2dda 100644 --- a/generic/tclLoadNone.c +++ b/generic/tclLoadNone.c @@ -81,7 +81,7 @@ TclpLoadMemory( { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory " - "is not available on this system", TCL_INDEX_NONE)); + "is not available on this system", -1)); } return TCL_ERROR; } diff --git a/generic/tclMain.c b/generic/tclMain.c index bb77e2897b16..2833ca8e1d80 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -280,7 +280,7 @@ Tcl_SourceRCFile( TCL_NORETURN void Tcl_MainEx( - size_t argc, /* Number of arguments. */ + Tcl_Size argc, /* Number of arguments. */ TCHAR **argv, /* Array of argument strings. */ Tcl_AppInitProc *appInitProc, /* Application-specific initialization @@ -288,7 +288,7 @@ Tcl_MainEx( * but before starting to execute commands. */ Tcl_Interp *interp) { - size_t i=0; /* argv[i] index */ + Tcl_Size i=0; /* argv[i] index */ Tcl_Obj *path, *resultPtr, *argvPtr, *appName; const char *encodingName = NULL; int code, exitCode = 0; @@ -297,7 +297,7 @@ Tcl_MainEx( InteractiveState is; TclpSetInitialEncodings(); - if (argc + 1 > 1) { + if (argc > 0) { --argc; /* consume argv[0] */ ++i; } @@ -326,7 +326,7 @@ Tcl_MainEx( */ /* mind argc is being adjusted as we proceed */ - if ((argc >= 3) && argv[1] && argv[2] && argv[3] && (0 == _tcscmp(TEXT("-encoding"), argv[1])) + if ((argc >= 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1])) && ('-' != argv[3][0])) { Tcl_Obj *value = NewNativeObj(argv[2]); Tcl_SetStartupScript(NewNativeObj(argv[3]), @@ -334,7 +334,7 @@ Tcl_MainEx( Tcl_DecrRefCount(value); argc -= 3; i += 3; - } else if ((argc >= 1) && argv[1] && ('-' != argv[1][0])) { + } else if ((argc >= 1) && ('-' != argv[1][0])) { Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL); argc--; i++; @@ -354,7 +354,7 @@ Tcl_MainEx( Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY); argvPtr = Tcl_NewListObj(0, NULL); - while (argc-- && argv[i]) { + while (argc--) { Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(argv[i++])); } Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY); @@ -454,7 +454,7 @@ Tcl_MainEx( while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) { mainLoopProc = TclGetMainLoop(); if (mainLoopProc == NULL) { - size_t length; + Tcl_Size length; if (is.tty) { Prompt(interp, &is); @@ -475,7 +475,7 @@ Tcl_MainEx( Tcl_IncrRefCount(is.commandPtr); } length = Tcl_GetsObj(is.input, is.commandPtr); - if (length == TCL_INDEX_NONE) { + if (length < 0) { if (Tcl_InputBlocked(is.input)) { /* * This can only happen if stdin has been set to @@ -740,7 +740,7 @@ StdinProc( TCL_UNUSED(int) /*mask*/) { int code; - size_t length; + Tcl_Size length; InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; @@ -752,7 +752,7 @@ StdinProc( Tcl_IncrRefCount(commandPtr); } length = Tcl_GetsObj(chan, commandPtr); - if (length == TCL_INDEX_NONE) { + if (length < 0) { if (Tcl_InputBlocked(chan)) { return; } diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 924ffd55a73d..0a4bf5814f67 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -410,7 +410,7 @@ Tcl_PopCallFrame( */ nsPtr = framePtr->nsPtr; - if ((--nsPtr->activationCount <= (unsigned)(nsPtr == iPtr->globalNsPtr)) + if ((--nsPtr->activationCount <= (nsPtr == iPtr->globalNsPtr)) && (nsPtr->flags & NS_DYING)) { Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr); } @@ -698,7 +698,7 @@ Tcl_CreateNamespace( if (deleteProc != NULL) { nameStr = name + strlen(name) - 2; if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') { - Tcl_DStringAppend(&tmpBuffer, name, TCL_INDEX_NONE); + Tcl_DStringAppend(&tmpBuffer, name, -1); while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0 && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') { Tcl_DStringSetLength(&tmpBuffer, nameLen-1); @@ -715,7 +715,7 @@ Tcl_CreateNamespace( if (*name == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" - " \"\": only global namespace can have empty name", TCL_INDEX_NONE)); + " \"\": only global namespace can have empty name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEGLOBAL", NULL); Tcl_DStringFree(&tmpBuffer); @@ -833,7 +833,7 @@ Tcl_CreateNamespace( Tcl_DString *tempPtr = namePtr; TclDStringAppendLiteral(buffPtr, "::"); - Tcl_DStringAppend(buffPtr, ancestorPtr->name, TCL_INDEX_NONE); + Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1); TclDStringAppendDString(buffPtr, namePtr); /* @@ -1006,7 +1006,7 @@ Tcl_DeleteNamespace( * FreeNsNameInternalRep when its refCount reaches 0. */ - if (nsPtr->activationCount > (unsigned)(nsPtr == globalNsPtr)) { + if (nsPtr->activationCount > (nsPtr == globalNsPtr)) { nsPtr->flags |= NS_DYING; if (nsPtr->parentPtr != NULL) { entryPtr = Tcl_FindHashEntry( @@ -1185,7 +1185,7 @@ TclTeardownNamespace( Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; Tcl_HashSearch search; - size_t i; + Tcl_Size i; /* * Start by destroying the namespace's variable table, since variables @@ -1206,7 +1206,7 @@ TclTeardownNamespace( */ while (nsPtr->cmdTable.numEntries > 0) { - size_t length = nsPtr->cmdTable.numEntries; + Tcl_Size length = nsPtr->cmdTable.numEntries; Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr, sizeof(Command *) * length); @@ -1396,7 +1396,7 @@ Tcl_Export( Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; - size_t neededElems, len, i; + Tcl_Size neededElems, len, i; /* * If the specified namespace is NULL, use the current namespace. @@ -1523,7 +1523,7 @@ Tcl_AppendExportList( * export pattern list is appended. */ { Namespace *nsPtr; - size_t i; + Tcl_Size i; int result; /* @@ -1542,7 +1542,7 @@ Tcl_AppendExportList( for (i = 0; i < nsPtr->numExportPatterns; i++) { result = Tcl_ListObjAppendElement(interp, objPtr, - Tcl_NewStringObj(nsPtr->exportArrayPtr[i], TCL_INDEX_NONE)); + Tcl_NewStringObj(nsPtr->exportArrayPtr[i], -1)); if (result != TCL_OK) { return result; } @@ -1621,7 +1621,7 @@ Tcl_Import( int result; TclNewLiteralStringObj(objv[0], "auto_import"); - objv[1] = Tcl_NewStringObj(pattern, TCL_INDEX_NONE); + objv[1] = Tcl_NewStringObj(pattern, -1); Tcl_IncrRefCount(objv[0]); Tcl_IncrRefCount(objv[1]); @@ -1726,7 +1726,7 @@ DoImport( Namespace *importNsPtr, int allowOverwrite) { - size_t i = 0, exported = 0; + Tcl_Size i = 0, exported = 0; Tcl_HashEntry *found; /* @@ -1762,11 +1762,11 @@ DoImport( ImportRef *refPtr; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, nsPtr->fullName, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, nsPtr->fullName, -1); if (nsPtr != ((Interp *) interp)->globalNsPtr) { TclDStringAppendLiteral(&ds, "::"); } - Tcl_DStringAppend(&ds, cmdName, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, cmdName, -1); /* * Check whether creating the new imported command in the current @@ -2638,7 +2638,7 @@ Tcl_FindCommand( cmdPtr = NULL; if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2) && !(flags & TCL_NAMESPACE_ONLY)) { - size_t i; + Tcl_Size i; Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr; (void) TclGetNamespaceForQualName(interp, name, cxtNsPtr, @@ -3049,11 +3049,11 @@ NamespaceChildrenCmd( if ((*name == ':') && (*(name+1) == ':')) { pattern = name; } else { - Tcl_DStringAppend(&buffer, nsPtr->fullName, TCL_INDEX_NONE); + Tcl_DStringAppend(&buffer, nsPtr->fullName, -1); if (nsPtr != globalNsPtr) { TclDStringAppendLiteral(&buffer, "::"); } - Tcl_DStringAppend(&buffer, name, TCL_INDEX_NONE); + Tcl_DStringAppend(&buffer, name, -1); pattern = Tcl_DStringValue(&buffer); } } @@ -3079,7 +3079,7 @@ NamespaceChildrenCmd( #endif ) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(pattern, TCL_INDEX_NONE)); + Tcl_NewStringObj(pattern, -1)); } goto searchDone; } @@ -3095,7 +3095,7 @@ NamespaceChildrenCmd( childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr); if ((pattern == NULL) || Tcl_StringMatch(childNsPtr->fullName, pattern)) { - elemPtr = Tcl_NewStringObj(childNsPtr->fullName, TCL_INDEX_NONE); + elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemPtr); } entryPtr = Tcl_NextHashEntry(&search); @@ -3145,7 +3145,7 @@ NamespaceCodeCmd( Namespace *currNsPtr; Tcl_Obj *listPtr, *objPtr; const char *arg; - size_t length; + Tcl_Size length; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "arg"); @@ -3185,7 +3185,7 @@ NamespaceCodeCmd( if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { TclNewLiteralStringObj(objPtr, "::"); } else { - objPtr = Tcl_NewStringObj(currNsPtr->fullName, TCL_INDEX_NONE); + objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1); } Tcl_ListObjAppendElement(interp, listPtr, objPtr); @@ -3243,7 +3243,7 @@ NamespaceCurrentCmd( if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2)); } else { - Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1)); } return TCL_OK; } @@ -3999,7 +3999,7 @@ NamespaceParentCmd( if (nsPtr->parentPtr != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - nsPtr->parentPtr->fullName, TCL_INDEX_NONE)); + nsPtr->parentPtr->fullName, -1)); } return TCL_OK; } @@ -4039,7 +4039,7 @@ NamespacePathCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); - size_t nsObjc, i; + Tcl_Size nsObjc, i; int result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; @@ -4060,7 +4060,7 @@ NamespacePathCmd( for (i=0 ; icommandPathLength ; i++) { if (nsPtr->commandPathArray[i].nsPtr != NULL) { Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj( - nsPtr->commandPathArray[i].nsPtr->fullName, TCL_INDEX_NONE)); + nsPtr->commandPathArray[i].nsPtr->fullName, -1)); } } Tcl_SetObjResult(interp, resultObj); @@ -4123,13 +4123,13 @@ NamespacePathCmd( void TclSetNsPath( Namespace *nsPtr, /* Namespace whose path is to be set. */ - size_t pathLength, /* Length of pathAry. */ + Tcl_Size pathLength, /* Length of pathAry. */ Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */ { if (pathLength != 0) { NamespacePathEntry *tmpPathArray = (NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength); - size_t i; + Tcl_Size i; for (i=0 ; icommandPathLength ; i++) { NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i]; @@ -4213,7 +4213,7 @@ UnlinkNsPath( * Side effects: * Increments the command reference epoch in each namespace whose path * includes the given namespace. This causes any cached resolved names - * whose root cacheing context starts at that namespace to be recomputed + * whose root caching context starts at that namespace to be recomputed * the next time they are used. * *---------------------------------------------------------------------- @@ -4286,7 +4286,7 @@ NamespaceQualifiersCmd( if ((*p == ':') && (p > name) && (*(p-1) == ':')) { p -= 2; /* Back up over the :: */ while ((p >= name) && (*p == ':')) { - p--; /* Back up over the preceeding : */ + p--; /* Back up over the preceding : */ } break; } @@ -4431,7 +4431,7 @@ Tcl_SetNamespaceUnknownHandler( Tcl_Namespace *nsPtr, /* Namespace which is being updated. */ Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */ { - size_t lstlen = 0; + Tcl_Size lstlen = 0; Namespace *currNsPtr = (Namespace *) nsPtr; /* @@ -4544,7 +4544,7 @@ NamespaceTailCmd( } if (p >= name) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, -1)); } return TCL_OK; } @@ -4565,7 +4565,7 @@ NamespaceTailCmd( * * Side effects: * Creates new variables in the current scope, linked to the - * corresponding variables in the stipulated nmamespace. If anything goes + * corresponding variables in the stipulated namespace. If anything goes * wrong, the result is an error message. * *---------------------------------------------------------------------- @@ -4927,8 +4927,8 @@ TclLogCommandInfo( * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - size_t length, /* Number of bytes in command (TCL_INDEX_NONE - * means use all bytes up to first null byte). + Tcl_Size length, /* Number of bytes in command (< 0 means use + * all bytes up to first null byte). */ const unsigned char *pc, /* Current pc of bytecode execution context */ Tcl_Obj **tosPtr) /* Current stack of bytecode execution @@ -4960,10 +4960,10 @@ TclLogCommandInfo( } } - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = strlen(command); } - overflow = (length > (size_t)limit); + overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) ? "while executing" : "invoked from within"), @@ -5013,7 +5013,7 @@ TclLogCommandInfo( iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { - size_t len; + Tcl_Size len; iPtr->resetErrorStack = 0; TclListObjLengthM(interp, iPtr->errorStack, &len); @@ -5085,7 +5085,7 @@ void TclErrorStackResetIf( Tcl_Interp *interp, const char *msg, - size_t length) + Tcl_Size length) { Interp *iPtr = (Interp *) interp; @@ -5098,7 +5098,7 @@ TclErrorStackResetIf( iPtr->errorStack = newObj; } if (iPtr->resetErrorStack) { - size_t len; + Tcl_Size len; iPtr->resetErrorStack = 0; TclListObjLengthM(interp, iPtr->errorStack, &len); @@ -5140,7 +5140,7 @@ Tcl_LogCommandInfo( * command (must be <= command). */ const char *command, /* First character in command that generated * the error. */ - size_t length) /* Number of bytes in command (-1 means use + Tcl_Size length) /* Number of bytes in command (-1 means use * all bytes up to first null byte). */ { TclLogCommandInfo(interp, script, command, length, NULL, NULL); diff --git a/generic/tclNotify.c b/generic/tclNotify.c index 24aa5cc190c9..3830192e8e41 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -1027,12 +1027,12 @@ Tcl_DoOneEvent( } /* - * If Tcl_WaitForEvent has returned 1, indicating that one system - * event has been dispatched (and thus that some Tcl code might have - * been indirectly executed), we break out of the loop. We do this to - * give VwaitCmd for instance a chance to check if that system event - * had the side effect of changing the variable (so the vwait can - * return and unwind properly). + * If Tcl_WaitForEvent has returned 1, indicating that one system event + * has been dispatched (and thus that some Tcl code might have been + * indirectly executed), we break out of the loop in order, e.g. to + * give vwait a chance to determine whether that system event had the + * side effect of changing the variable (so the vwait can return and + * unwind properly). * * NB: We will process idle events if any first, because otherwise we * might never do the idle events if the notifier always gets diff --git a/generic/tclOO.c b/generic/tclOO.c index bee06e2f10a9..b05fe1fd5689 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -352,14 +352,14 @@ InitFoundation( Tcl_DStringInit(&buffer); for (i = 0 ; defineCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::define::"); - Tcl_DStringAppend(&buffer, defineCmds[i].name, TCL_INDEX_NONE); + Tcl_DStringAppend(&buffer, defineCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL); Tcl_DStringFree(&buffer); } for (i = 0 ; objdefCmds[i].name ; i++) { TclDStringAppendLiteral(&buffer, "::oo::objdefine::"); - Tcl_DStringAppend(&buffer, objdefCmds[i].name, TCL_INDEX_NONE); + Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1); Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer), objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL); Tcl_DStringFree(&buffer); @@ -654,7 +654,7 @@ AllocObject( while (1) { char objName[10 + TCL_INTEGER_SPACE]; - sprintf(objName, "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount); + snprintf(objName, sizeof(objName), "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount); oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL); if (oPtr->namespacePtr != NULL) { creationEpoch = fPtr->tsdPtr->nsCount; @@ -960,7 +960,7 @@ TclOOReleaseClassContents( Object *oPtr) /* The object representing the class. */ { FOREACH_HASH_DECLS; - size_t i; + Tcl_Size i; Class *clsPtr = oPtr->classPtr, *tmpClsPtr; Method *mPtr; Foundation *fPtr = oPtr->fPtr; @@ -1121,7 +1121,7 @@ ObjectNamespaceDeleted( Tcl_Obj *filterObj, *variableObj; PrivateVariableMapping *privateVariable; Tcl_Interp *interp = oPtr->fPtr->interp; - size_t i; + Tcl_Size i; if (Destructing(oPtr)) { /* @@ -1134,7 +1134,7 @@ ObjectNamespaceDeleted( /* * One rule for the teardown routines is that if an object is in the - * process of being deleted, nothing else may modify its bookeeping + * process of being deleted, nothing else may modify its bookkeeping * records. This is the flag that */ @@ -1187,7 +1187,7 @@ ObjectNamespaceDeleted( if (((Command *) oPtr->command)->flags && CMD_DYING) { /* * Something has already started the command deletion process. We can - * go ahead and clean up the the namespace, + * go ahead and clean up the namespace, */ } else { /* @@ -1362,7 +1362,7 @@ TclOORemoveFromInstances( Class *clsPtr) /* The class (possibly) containing the * reference to the instance. */ { - size_t i; + Tcl_Size i; int res = 0; Object *instPtr; @@ -1425,7 +1425,7 @@ TclOORemoveFromMixins( Object *oPtr) /* The object (possibly) containing the * reference to the mixin. */ { - size_t i; + Tcl_Size i; int res = 0; Class *mixPtr; @@ -1461,7 +1461,7 @@ TclOORemoveFromSubclasses( Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - size_t i; + Tcl_Size i; int res = 0; Class *subclsPtr; @@ -1526,7 +1526,7 @@ TclOORemoveFromMixinSubs( Class *superPtr) /* The superclass to possibly remove the * subclass reference from. */ { - size_t i; + Tcl_Size i; int res = 0; Class *subclsPtr; @@ -1667,10 +1667,10 @@ Tcl_NewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - size_t objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - size_t skip) /* Number of arguments to _not_ pass to the + Tcl_Size skip) /* Number of arguments to _not_ pass to the * constructor. */ { Class *classPtr = (Class *) cls; @@ -1735,10 +1735,10 @@ TclNRNewObjectInstance( const char *nsNameStr, /* Name of namespace to create inside object, * or NULL to ask the code to pick its own * unique name. */ - size_t objc, /* Number of arguments. Negative value means + Tcl_Size objc, /* Number of arguments. Negative value means * do not call constructor. */ Tcl_Obj *const *objv, /* Argument list. */ - size_t skip, /* Number of arguments to _not_ pass to the + Tcl_Size skip, /* Number of arguments to _not_ pass to the * constructor. */ Tcl_Object *objectPtr) /* Place to write the object reference upon * successful allocation. */ @@ -1758,7 +1758,7 @@ TclNRNewObjectInstance( * object cloning only). If there aren't any constructors, we do nothing. */ - if (objc == TCL_INDEX_NONE) { + if (objc < 0) { *objectPtr = (Tcl_Object) oPtr; return TCL_OK; } @@ -1870,7 +1870,7 @@ FinalizeAlloc( if (result != TCL_ERROR && Destructing(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object deleted in constructor", TCL_INDEX_NONE)); + "object deleted in constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL); result = TCL_ERROR; } @@ -1932,7 +1932,7 @@ Tcl_CopyObjectInstance( CallContext *contextPtr; Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3]; PrivateVariableMapping *privateVariable; - size_t i; + Tcl_Size i; int result; /* @@ -1941,7 +1941,7 @@ Tcl_CopyObjectInstance( if (IsRootClass(oPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not clone the class of classes", TCL_INDEX_NONE)); + "may not clone the class of classes", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL); return NULL; } @@ -1952,7 +1952,7 @@ Tcl_CopyObjectInstance( o2Ptr = (Object *) Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, TCL_INDEX_NONE, - NULL, TCL_INDEX_NONE); + NULL, -1); if (o2Ptr == NULL) { return NULL; } @@ -2556,7 +2556,7 @@ TclOOInvokeObject( * (PRIVATE_METHOD), or a *really* private * context (any other value; conventionally * 0). */ - size_t objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Array of argument objects. It is assumed * that the name of the method to invoke will * be at index 1. */ @@ -2627,7 +2627,7 @@ int TclOOObjectCmdCore( Object *oPtr, /* The object being invoked. */ Tcl_Interp *interp, /* The interpreter containing the object. */ - size_t objc, /* How many arguments are being passed in. */ + Tcl_Size objc, /* How many arguments are being passed in. */ Tcl_Obj *const *objv, /* The array of arguments. */ int flags, /* Whether this is an invocation through the * public or the private command interface. */ @@ -2648,7 +2648,7 @@ TclOOObjectCmdCore( * processing. */ - if (objc + 1 < 3) { + if (objc < 2) { flags |= FORCE_UNKNOWN; methodNamePtr = NULL; goto noMapping; @@ -2749,7 +2749,7 @@ TclOOObjectCmdCore( } if (contextPtr->index >= contextPtr->callPtr->numChain) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no valid method implementation", TCL_INDEX_NONE)); + "no valid method implementation", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(methodNamePtr), NULL); TclOODeleteContext(contextPtr); @@ -2799,9 +2799,9 @@ int Tcl_ObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - size_t objc, + Tcl_Size objc, Tcl_Obj *const *objv, - size_t skip) + Tcl_Size skip) { CallContext *contextPtr = (CallContext *) context; size_t savedIndex = contextPtr->index; @@ -2871,9 +2871,9 @@ int TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, - size_t objc, + Tcl_Size objc, Tcl_Obj *const *objv, - size_t skip) + Tcl_Size skip) { CallContext *contextPtr = (CallContext *) context; @@ -3000,7 +3000,7 @@ TclOOIsReachable( Class *targetPtr, Class *startPtr) { - size_t i; + Tcl_Size i; Class *superPtr; tailRecurse: @@ -3093,7 +3093,7 @@ Tcl_ObjectContextObject( return (Tcl_Object) ((CallContext *)context)->oPtr; } -size_t +Tcl_Size Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context) { diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 3783adfd64f8..2df34d0e7969 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -68,8 +68,8 @@ declare 12 { } declare 13 { Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, - const char *nameStr, const char *nsNameStr, size_t objc, - Tcl_Obj *const *objv, size_t skip) + const char *nameStr, const char *nsNameStr, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip) } declare 14 { int Tcl_ObjectDeleted(Tcl_Object object) @@ -84,7 +84,7 @@ declare 17 { Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context) } declare 18 { - size_t Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) + Tcl_Size Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context) } declare 19 { void *Tcl_ClassGetMetadata(Tcl_Class clazz, @@ -104,8 +104,8 @@ declare 22 { } declare 23 { int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, - Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, - size_t skip) + Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, + Tcl_Size skip) } declare 24 { Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper( @@ -184,7 +184,7 @@ declare 4 { ProcedureMethod **pmPtrPtr) } declare 5 { - int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, size_t objc, + int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls) } declare 6 { @@ -214,24 +214,24 @@ declare 10 { } declare 11 { int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, - Tcl_Class startCls, int publicPrivate, size_t objc, + Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv) } declare 12 { - void TclOOObjectSetFilters(Object *oPtr, size_t numFilters, + void TclOOObjectSetFilters(Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters) } declare 13 { void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, - size_t numFilters, Tcl_Obj *const *filters) + Tcl_Size numFilters, Tcl_Obj *const *filters) } declare 14 { - void TclOOObjectSetMixins(Object *oPtr, size_t numMixins, + void TclOOObjectSetMixins(Object *oPtr, Tcl_Size numMixins, Class *const *mixins) } declare 15 { void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, - size_t numMixins, Class *const *mixins) + Tcl_Size numMixins, Class *const *mixins) } return diff --git a/generic/tclOO.h b/generic/tclOO.h index 6f1849160a6e..524acb9f7a7d 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -63,7 +63,7 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext; typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv); typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp, - Tcl_ObjectContext objectContext, size_t objc, Tcl_Obj *const *objv); + Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv); typedef void (Tcl_MethodDeleteProc)(void *clientData); typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData, void **newClientData); diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 1ad351d6992e..e644a2f93cb5 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -100,10 +100,10 @@ TclOO_Class_Constructor( * here (and the class definition delegate doesn't run any constructors). */ - nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, TCL_INDEX_NONE); - Tcl_AppendToObj(nameObj, ":: oo ::delegate", TCL_INDEX_NONE); + nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1); + Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1); Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls, - TclGetString(nameObj), NULL, TCL_INDEX_NONE, NULL, TCL_INDEX_NONE); + TclGetString(nameObj), NULL, -1, NULL, -1); Tcl_DecrRefCount(nameObj); /* @@ -148,7 +148,7 @@ DecrRefsPostClassConstructor( TclDecrRefCount(invoke[0]); TclDecrRefCount(invoke[1]); TclDecrRefCount(invoke[2]); - invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", TCL_INDEX_NONE); + invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1); invoke[1] = TclOOObjectName(interp, oPtr); Tcl_IncrRefCount(invoke[0]); Tcl_IncrRefCount(invoke[1]); @@ -185,7 +185,7 @@ TclOO_Class_Create( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName; - size_t len; + Tcl_Size len; /* * Sanity check; should not be possible to invoke this method on a @@ -205,7 +205,7 @@ TclOO_Class_Create( * Check we have the right number of (sensible) arguments. */ - if ((size_t)objc < 1 + Tcl_ObjectContextSkippedArgs(context)) { + if (objc < 1 + Tcl_ObjectContextSkippedArgs(context)) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName ?arg ...?"); return TCL_ERROR; @@ -214,7 +214,7 @@ TclOO_Class_Create( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object name must not be empty", TCL_INDEX_NONE)); + "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } @@ -250,7 +250,7 @@ TclOO_Class_CreateNs( { Object *oPtr = (Object *) Tcl_ObjectContextObject(context); const char *objName, *nsName; - size_t len; + Tcl_Size len; /* * Sanity check; should not be possible to invoke this method on a @@ -270,7 +270,7 @@ TclOO_Class_CreateNs( * Check we have the right number of (sensible) arguments. */ - if ((size_t)objc + 1 < Tcl_ObjectContextSkippedArgs(context) + 3) { + if (objc + 1 < Tcl_ObjectContextSkippedArgs(context) + 3) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "objectName namespaceName ?arg ...?"); return TCL_ERROR; @@ -279,7 +279,7 @@ TclOO_Class_CreateNs( objv[Tcl_ObjectContextSkippedArgs(context)], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "object name must not be empty", TCL_INDEX_NONE)); + "object name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } @@ -287,7 +287,7 @@ TclOO_Class_CreateNs( objv[Tcl_ObjectContextSkippedArgs(context)+1], &len); if (len == 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "namespace name must not be empty", TCL_INDEX_NONE)); + "namespace name must not be empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL); return TCL_ERROR; } @@ -600,14 +600,14 @@ TclOO_Object_Unknown( TclGetString(objv[skip])); for (i=0 ; icallPtr->chain[ callerContext->index].mPtr; PrivateVariableMapping *pvPtr; - size_t i; + Tcl_Size i; if (mPtr->declaringObjectPtr == oPtr) { FOREACH_STRUCT(pvPtr, oPtr->privateVariables) { @@ -816,7 +816,7 @@ TclOO_Object_VarName( } } - varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, TCL_INDEX_NONE); + varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1); Tcl_AppendToObj(varNamePtr, "::", 2); Tcl_AppendObjToObj(varNamePtr, argPtr); } @@ -842,10 +842,10 @@ TclOO_Object_VarName( * WARNING! This code pokes inside the implementation of hash tables! */ - Tcl_AppendToObj(varNamePtr, "(", TCL_INDEX_NONE); + Tcl_AppendToObj(varNamePtr, "(", -1); Tcl_AppendObjToObj(varNamePtr, ((VarInHash *) varPtr)->entry.key.objPtr); - Tcl_AppendToObj(varNamePtr, ")", TCL_INDEX_NONE); + Tcl_AppendToObj(varNamePtr, ")", -1); } else { Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr); } @@ -912,7 +912,7 @@ TclOONextToObjCmd( CallFrame *framePtr = iPtr->varFramePtr; Class *classPtr; CallContext *contextPtr; - size_t i; + Tcl_Size i; Tcl_Object object; const char *methodType; @@ -1092,14 +1092,14 @@ TclOOSelfObjCmd( return TCL_OK; case SELF_NS: Tcl_SetObjResult(interp, Tcl_NewStringObj( - contextPtr->oPtr->namespacePtr->fullName, TCL_INDEX_NONE)); + contextPtr->oPtr->namespacePtr->fullName, -1)); return TCL_OK; case SELF_CLASS: { Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr; if (clsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method not defined by a class", TCL_INDEX_NONE)); + "method not defined by a class", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } @@ -1120,7 +1120,7 @@ TclOOSelfObjCmd( case SELF_FILTER: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not inside a filtering context", TCL_INDEX_NONE)); + "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { @@ -1137,7 +1137,7 @@ TclOOSelfObjCmd( } result[0] = TclOOObjectName(interp, oPtr); - result[1] = Tcl_NewStringObj(type, TCL_INDEX_NONE); + result[1] = Tcl_NewStringObj(type, -1); result[2] = miPtr->mPtr->namePtr; Tcl_SetObjResult(interp, Tcl_NewListObj(3, result)); return TCL_OK; @@ -1146,7 +1146,7 @@ TclOOSelfObjCmd( if ((framePtr->callerVarPtr == NULL) || !(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "caller is not an object", TCL_INDEX_NONE)); + "caller is not an object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); return TCL_ERROR; } else { @@ -1164,7 +1164,7 @@ TclOOSelfObjCmd( */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", TCL_INDEX_NONE)); + "method without declarer!", -1)); return TCL_ERROR; } @@ -1196,7 +1196,7 @@ TclOOSelfObjCmd( */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", TCL_INDEX_NONE)); + "method without declarer!", -1)); return TCL_ERROR; } @@ -1214,13 +1214,13 @@ TclOOSelfObjCmd( case SELF_TARGET: if (!CurrentlyInvoked(contextPtr).isFilter) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "not inside a filtering context", TCL_INDEX_NONE)); + "not inside a filtering context", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL); return TCL_ERROR; } else { Method *mPtr; Object *declarerPtr; - size_t i; + Tcl_Size i; for (i=contextPtr->index ; icallPtr->numChain ; i++){ if (!contextPtr->callPtr->chain[i].isFilter) { @@ -1241,7 +1241,7 @@ TclOOSelfObjCmd( */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method without declarer!", TCL_INDEX_NONE)); + "method without declarer!", -1)); return TCL_ERROR; } result[0] = TclOOObjectName(interp, declarerPtr); diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index fcf7f2b89bd8..5c9c986a852f 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -327,7 +327,7 @@ TclOOInvokeContext( */ if (contextPtr->index == 0) { - size_t i; + Tcl_Size i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { AddRef(contextPtr->callPtr->chain[i].mPtr); @@ -409,7 +409,7 @@ FinalizeMethodRefs( int result) { CallContext *contextPtr = (CallContext *)data[0]; - size_t i; + Tcl_Size i; for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) { TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); @@ -450,7 +450,7 @@ TclOOGetSortedMethodList( * at. Is set-like in nature and keyed by * pointer to class. */ FOREACH_HASH_DECLS; - size_t i, numStrings; + Tcl_Size i, numStrings; Class *mixinPtr; Tcl_Obj *namePtr; Method *mPtr; @@ -691,7 +691,7 @@ AddClassMethodNames( * pointers to the classes, and the values are * immaterial. */ { - size_t i; + Tcl_Size i; /* * If we've already started looking at this class, stop working on it now @@ -882,7 +882,7 @@ AddSimpleChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - size_t i; + Tcl_Size i; int foundPrivate = 0, blockedUnexported = 0; Tcl_HashEntry *hPtr; Method *mPtr; @@ -975,7 +975,7 @@ AddMethodToCallChain( * not passed a mixin. */ { CallChain *callPtr = cbPtr->callChainPtr; - size_t i; + Tcl_Size i; /* * Return if this is just an entry used to record whether this is a public @@ -1155,7 +1155,7 @@ TclOOGetCallContext( CallContext *contextPtr; CallChain *callPtr; struct ChainBuilder cb; - size_t i, count; + Tcl_Size i, count; int doFilters, donePrivate = 0; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; @@ -1416,7 +1416,7 @@ TclOOGetStereotypeCallChain( { CallChain *callPtr; struct ChainBuilder cb; - size_t count; + Tcl_Size count; Foundation *fPtr = clsPtr->thisPtr->fPtr; Tcl_HashEntry *hPtr; Tcl_HashTable doneFilters; @@ -1496,7 +1496,7 @@ TclOOGetStereotypeCallChain( /* * Check to see if the method has no implementation. If so, we probably * need to add in a call to the unknown method. Otherwise, set up the - * cacheing of the method implementation (if relevant). + * caching of the method implementation (if relevant). */ if (count == callPtr->numChain) { @@ -1551,7 +1551,7 @@ AddClassFiltersToCallContext( int flags) /* Whether we've gone along a mixin link * yet. */ { - size_t i; + Tcl_Size i; int clearedFlags = flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS); Class *superPtr, *mixinPtr; @@ -1640,7 +1640,7 @@ AddPrivatesFromClassChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - size_t i; + Tcl_Size i; Class *superPtr; /* @@ -1718,7 +1718,7 @@ AddSimpleClassChainToCallContext( * NULL, either the filter was declared by the * object or this isn't a filter. */ { - size_t i; + Tcl_Size i; int privateDanger = 0; Class *superPtr; @@ -1804,7 +1804,7 @@ TclOORenderCallChain( Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral; Tcl_Obj *resultObj, *descObjs[4], **objv; Foundation *fPtr = TclOOGetFoundation(interp); - size_t i; + Tcl_Size i; /* * Allocate the literals (potentially) used in our description. @@ -1832,7 +1832,7 @@ TclOORenderCallChain( */ objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *)); - for (i = 0 ; i < (size_t)callPtr->numChain ; i++) { + for (i = 0 ; i < callPtr->numChain ; i++) { struct MInvoke *miPtr = &callPtr->chain[i]; descObjs[0] = @@ -1848,7 +1848,7 @@ TclOORenderCallChain( ? Tcl_GetObjectName(interp, (Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr) : objectLiteral; - descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, TCL_INDEX_NONE); + descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1); objv[i] = Tcl_NewListObj(4, descObjs); } @@ -1960,7 +1960,7 @@ AddSimpleDefineNamespaces( * building. */ { Class *mixinPtr; - size_t i; + Tcl_Size i; FOREACH(mixinPtr, oPtr->mixins) { AddSimpleClassDefineNamespaces(mixinPtr, definePtr, @@ -1989,7 +1989,7 @@ AddSimpleClassDefineNamespaces( int flags) /* What sort of define chain are we * building. */ { - size_t i; + Tcl_Size i; Class *superPtr; /* diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 0c141fe6e9dd..cf554786e4e8 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -69,8 +69,8 @@ TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, /* 13 */ TCLAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, - const char *nsNameStr, size_t objc, - Tcl_Obj *const *objv, size_t skip); + const char *nsNameStr, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip); /* 14 */ TCLAPI int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ @@ -81,7 +81,7 @@ TCLAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ TCLAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ -TCLAPI size_t Tcl_ObjectContextSkippedArgs( +TCLAPI Tcl_Size Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ TCLAPI void * Tcl_ClassGetMetadata(Tcl_Class clazz, @@ -99,8 +99,8 @@ TCLAPI void Tcl_ObjectSetMetadata(Tcl_Object object, void *metadata); /* 23 */ TCLAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, - Tcl_ObjectContext context, size_t objc, - Tcl_Obj *const *objv, size_t skip); + Tcl_ObjectContext context, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip); /* 24 */ TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); @@ -159,17 +159,17 @@ typedef struct TclOOStubs { Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */ - Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, size_t objc, Tcl_Obj *const *objv, size_t skip); /* 13 */ + Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 13 */ int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */ int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */ Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */ Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */ - size_t (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ + Tcl_Size (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */ void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */ void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */ void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */ void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */ - int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, size_t objc, Tcl_Obj *const *objv, size_t skip); /* 23 */ + int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, Tcl_Size objc, Tcl_Obj *const *objv, Tcl_Size skip); /* 23 */ Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */ void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */ void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */ diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 796a22f319ce..84204f9f2581 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -249,10 +249,10 @@ RecomputeClassCacheFlag( void TclOOObjectSetFilters( Object *oPtr, - size_t numFilters, + Tcl_Size numFilters, Tcl_Obj *const *filters) { - size_t i; + Tcl_Size i; if (oPtr->filters.num) { Tcl_Obj *filterObj; @@ -309,10 +309,10 @@ void TclOOClassSetFilters( Tcl_Interp *interp, Class *classPtr, - size_t numFilters, + Tcl_Size numFilters, Tcl_Obj *const *filters) { - size_t i; + Tcl_Size i; if (classPtr->filters.num) { Tcl_Obj *filterObj; @@ -371,11 +371,11 @@ TclOOClassSetFilters( void TclOOObjectSetMixins( Object *oPtr, - size_t numMixins, + Tcl_Size numMixins, Class *const *mixins) { Class *mixinPtr; - size_t i; + Tcl_Size i; if (numMixins == 0) { if (oPtr->mixins.num != 0) { @@ -432,11 +432,11 @@ void TclOOClassSetMixins( Tcl_Interp *interp, Class *classPtr, - size_t numMixins, + Tcl_Size numMixins, Class *const *mixins) { Class *mixinPtr; - size_t i; + Tcl_Size i; if (numMixins == 0) { if (classPtr->mixins.num != 0) { @@ -485,11 +485,11 @@ TclOOClassSetMixins( static inline void InstallStandardVariableMapping( VariableNameList *vnlPtr, - size_t varc, + Tcl_Size varc, Tcl_Obj *const *varv) { Tcl_Obj *variableObj; - size_t i, n; + Tcl_Size i, n; int created; Tcl_HashTable uniqueTable; @@ -535,12 +535,12 @@ InstallStandardVariableMapping( static inline void InstallPrivateVariableMapping( PrivateVariableList *pvlPtr, - size_t varc, + Tcl_Size varc, Tcl_Obj *const *varv, int creationEpoch) { PrivateVariableMapping *privatePtr; - size_t i, n; + Tcl_Size i, n; int created; Tcl_HashTable uniqueTable; @@ -633,7 +633,7 @@ RenameDeleteMethod( if (hPtr == newHPtr) { renameToSelf: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot rename method to itself", TCL_INDEX_NONE)); + "cannot rename method to itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL); return TCL_ERROR; } else if (!isNew) { @@ -704,12 +704,12 @@ TclOOUnknownDefinition( Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_HashSearch search; Tcl_HashEntry *hPtr; - size_t soughtLen; + Tcl_Size soughtLen; const char *soughtStr, *matchedStr = NULL; if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "bad call of unknown handler", TCL_INDEX_NONE)); + "bad call of unknown handler", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL); return TCL_ERROR; } @@ -743,7 +743,7 @@ TclOOUnknownDefinition( TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1)); int result; - newObjv[0] = Tcl_NewStringObj(matchedStr, TCL_INDEX_NONE); + newObjv[0] = Tcl_NewStringObj(matchedStr, -1); Tcl_IncrRefCount(newObjv[0]); if (objc > 2) { memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2)); @@ -778,7 +778,7 @@ FindCommand( Tcl_Obj *stringObj, Tcl_Namespace *const namespacePtr) { - size_t length; + Tcl_Size length; const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length); Namespace *const nsPtr = (Namespace *) namespacePtr; FOREACH_HASH_DECLS; @@ -846,7 +846,7 @@ InitDefineContext( if (namespacePtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "no definition namespace available", TCL_INDEX_NONE)); + "no definition namespace available", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -887,7 +887,7 @@ TclOOGetDefineCmdContext( && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command may only be called from within the context of" - " an ::oo::define or ::oo::objdefine command", TCL_INDEX_NONE)); + " an ::oo::define or ::oo::objdefine command", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } @@ -895,7 +895,7 @@ TclOOGetDefineCmdContext( if (Tcl_ObjectDeleted(object)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "this command cannot be called when the object has been" - " deleted", TCL_INDEX_NONE)); + " deleted", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return NULL; } @@ -938,7 +938,7 @@ GetClassInOuterContext( return NULL; } if (oPtr->classPtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS", TclGetString(className), NULL); return NULL; @@ -997,16 +997,16 @@ GenerateErrorInfo( * an object, class or class-as-object that * was being configured. */ { - size_t length; + Tcl_Size length; Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr) ? savedNameObj : TclOOObjectName(interp, oPtr); const char *objName = Tcl_GetStringFromObj(realNameObj, &length); - unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; + int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT; int overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (in definition script for %s \"%.*s%s\" line %d)", - typeOfSubject, (overflow ? limit : (unsigned)length), objName, + typeOfSubject, (overflow ? limit : (int)length), objName, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } @@ -1034,7 +1034,7 @@ MagicDefinitionInvoke( Tcl_Obj *objPtr, *obj2Ptr, **objs; Tcl_Command cmd; int isRoot, result, offset = cmdIndex + 1; - size_t dummy; + Tcl_Size dummy; /* * More than one argument: fire them through the ensemble processing @@ -1437,13 +1437,13 @@ TclOODefineClassObjCmd( } if (oPtr->flags & ROOT_OBJECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the class of the root object class", TCL_INDEX_NONE)); + "may not modify the class of the root object class", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } if (oPtr->flags & ROOT_CLASS) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the class of the class of classes", TCL_INDEX_NONE)); + "may not modify the class of the class of classes", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1463,7 +1463,7 @@ TclOODefineClassObjCmd( } if (oPtr == clsPtr->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not change classes into an instance of themselves", TCL_INDEX_NONE)); + "may not change classes into an instance of themselves", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1534,7 +1534,7 @@ TclOODefineConstructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - size_t bodyLength; + Tcl_Size bodyLength; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arguments body"); @@ -1616,7 +1616,7 @@ TclOODefineDefnNsObjCmd( } if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1647,7 +1647,7 @@ TclOODefineDefnNsObjCmd( if (nsPtr == NULL) { return TCL_ERROR; } - nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); + nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, -1); Tcl_IncrRefCount(nsNamePtr); } @@ -1700,7 +1700,7 @@ TclOODefineDeleteMethodObjCmd( } if (!isInstanceDeleteMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1745,7 +1745,7 @@ TclOODefineDestructorObjCmd( Object *oPtr; Class *clsPtr; Tcl_Method method; - size_t bodyLength; + Tcl_Size bodyLength; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "body"); @@ -1826,7 +1826,7 @@ TclOODefineExportObjCmd( clsPtr = oPtr->classPtr; if (!isInstanceExport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1920,7 +1920,7 @@ TclOODefineForwardObjCmd( } if (!isInstanceForward && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -1998,7 +1998,7 @@ TclOODefineMethodObjCmd( } if (!isInstanceMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2077,7 +2077,7 @@ TclOODefineRenameMethodObjCmd( } if (!isInstanceRenameMethod && !oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2139,7 +2139,7 @@ TclOODefineUnexportObjCmd( clsPtr = oPtr->classPtr; if (!isInstanceUnexport && !clsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2268,9 +2268,9 @@ TclOODefineSlots( Foundation *fPtr) { const struct DeclaredSlot *slotInfoPtr; - Tcl_Obj *getName = Tcl_NewStringObj("Get", TCL_INDEX_NONE); - Tcl_Obj *setName = Tcl_NewStringObj("Set", TCL_INDEX_NONE); - Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", TCL_INDEX_NONE); + Tcl_Obj *getName = Tcl_NewStringObj("Get", -1); + Tcl_Obj *setName = Tcl_NewStringObj("Set", -1); + Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1); Class *slotCls; slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class) @@ -2324,9 +2324,9 @@ ClassFilterGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *filterObj; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2335,7 +2335,7 @@ ClassFilterGet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2357,10 +2357,10 @@ ClassFilterSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t filterc; + Tcl_Size filterc; Tcl_Obj **filterv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; @@ -2371,7 +2371,7 @@ ClassFilterSet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElementsM(interp, objv[0], &filterc, @@ -2405,9 +2405,9 @@ ClassMixinGet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *mixinPtr; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2416,7 +2416,7 @@ ClassMixinGet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2440,11 +2440,11 @@ ClassMixinSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t mixinc, i; + Tcl_Size mixinc, i; Tcl_Obj **mixinv; Class **mixins; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; @@ -2455,7 +2455,7 @@ ClassMixinSet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElementsM(interp, objv[0], &mixinc, @@ -2474,7 +2474,7 @@ ClassMixinSet( } if (TclOOIsReachable(oPtr->classPtr, mixins[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not mix a class into itself", TCL_INDEX_NONE)); + "may not mix a class into itself", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL); goto freeAndError; } @@ -2511,9 +2511,9 @@ ClassSuperGet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *superPtr; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2522,7 +2522,7 @@ ClassSuperGet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2545,12 +2545,12 @@ ClassSuperSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t superc, j; - size_t i; + Tcl_Size superc, j; + Tcl_Size i; Tcl_Obj **superv; Class **superclasses, *superPtr; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "superclassList"); return TCL_ERROR; @@ -2561,12 +2561,12 @@ ClassSuperSet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "may not modify the superclass of the root object", TCL_INDEX_NONE)); + "may not modify the superclass of the root object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElementsM(interp, objv[0], &superc, @@ -2614,7 +2614,7 @@ ClassSuperSet( } if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to form circular dependency graph", TCL_INDEX_NONE)); + "attempt to form circular dependency graph", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL); failedAfterAlloc: for (; i-- > 0 ;) { @@ -2678,9 +2678,9 @@ ClassVarsGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2689,7 +2689,7 @@ ClassVarsGet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } @@ -2721,11 +2721,11 @@ ClassVarsSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t i; - size_t varc; + Tcl_Size i; + Tcl_Size varc; Tcl_Obj **varv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; @@ -2736,7 +2736,7 @@ ClassVarsSet( return TCL_ERROR; } else if (!oPtr->classPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to misuse API", TCL_INDEX_NONE)); + "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; } else if (TclListObjGetElementsM(interp, objv[0], &varc, @@ -2793,9 +2793,9 @@ ObjFilterGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj, *filterObj; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2820,10 +2820,10 @@ ObjFilterSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t filterc; + Tcl_Size filterc; Tcl_Obj **filterv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "filterList"); return TCL_ERROR; @@ -2862,9 +2862,9 @@ ObjMixinGet( Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; Class *mixinPtr; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2892,12 +2892,12 @@ ObjMixinSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t i; - size_t mixinc; + Tcl_Size i; + Tcl_Size mixinc; Tcl_Obj **mixinv; Class **mixins; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "mixinList"); return TCL_ERROR; @@ -2947,9 +2947,9 @@ ObjVarsGet( { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; - if (Tcl_ObjectContextSkippedArgs(context) != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, NULL); return TCL_ERROR; @@ -2984,10 +2984,10 @@ ObjVarsSet( Tcl_Obj *const *objv) { Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp); - size_t varc, i; + Tcl_Size varc, i; Tcl_Obj **varv; - if (Tcl_ObjectContextSkippedArgs(context) + 1 != (size_t)objc) { + if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) { Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv, "variableList"); return TCL_ERROR; diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index a49282c70d79..1f27b4194310 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -120,10 +120,10 @@ TclOOInitInfo( infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY); if (infoCmd) { Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", TCL_INDEX_NONE), - Tcl_NewStringObj("::oo::InfoObject", TCL_INDEX_NONE)); - Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", TCL_INDEX_NONE), - Tcl_NewStringObj("::oo::InfoClass", TCL_INDEX_NONE)); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1), + Tcl_NewStringObj("::oo::InfoObject", -1)); + Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1), + Tcl_NewStringObj("::oo::InfoClass", -1)); Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict); } } @@ -194,7 +194,7 @@ InfoObjectClassCmd( return TCL_OK; } else { Class *mixinPtr, *o2clsPtr; - size_t i; + Tcl_Size i; o2clsPtr = GetClassFromObj(interp, objv[2]); if (o2clsPtr == NULL) { @@ -264,7 +264,7 @@ InfoObjectDefnCmd( procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", TCL_INDEX_NONE)); + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -278,7 +278,7 @@ InfoObjectDefnCmd( TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } @@ -307,7 +307,7 @@ InfoObjectFiltersCmd( int objc, Tcl_Obj *const objv[]) { - size_t i; + Tcl_Size i; Tcl_Obj *filterObj, *resultObj; Object *oPtr; @@ -411,7 +411,7 @@ InfoObjectIsACmd( } idx; Object *oPtr, *o2Ptr; int result = 0; - size_t i; + Tcl_Size i; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?"); @@ -610,7 +610,7 @@ InfoObjectMethodsCmd( for (i=0 ; i 0) { Tcl_Free((void *)names); @@ -679,7 +679,7 @@ InfoObjectMethodTypeCmd( goto unknownMethod; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); return TCL_OK; } @@ -703,7 +703,7 @@ InfoObjectMixinsCmd( Class *mixinPtr; Object *oPtr; Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "objName"); @@ -787,7 +787,7 @@ InfoObjectNsCmd( } Tcl_SetObjResult(interp, - Tcl_NewStringObj(oPtr->namespacePtr->fullName, TCL_INDEX_NONE)); + Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1)); return TCL_OK; } @@ -810,7 +810,7 @@ InfoObjectVariablesCmd( { Object *oPtr; Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; int isPrivate = 0; if (objc != 2 && objc != 3) { @@ -943,7 +943,7 @@ InfoClassConstrCmd( procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", TCL_INDEX_NONE)); + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL); return TCL_ERROR; } @@ -956,7 +956,7 @@ InfoClassConstrCmd( TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } @@ -1010,7 +1010,7 @@ InfoClassDefnCmd( procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", TCL_INDEX_NONE)); + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[2]), NULL); return TCL_ERROR; @@ -1024,7 +1024,7 @@ InfoClassDefnCmd( TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } @@ -1121,7 +1121,7 @@ InfoClassDestrCmd( procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "definition not available for this kind of method", TCL_INDEX_NONE)); + "definition not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL); return TCL_ERROR; } @@ -1147,7 +1147,7 @@ InfoClassFiltersCmd( int objc, Tcl_Obj *const objv[]) { - size_t i; + Tcl_Size i; Tcl_Obj *filterObj, *resultObj; Class *clsPtr; @@ -1238,7 +1238,7 @@ InfoClassInstancesCmd( { Object *oPtr; Class *clsPtr; - size_t i; + Tcl_Size i; const char *pattern = NULL; Tcl_Obj *resultObj; @@ -1361,11 +1361,11 @@ InfoClassMethodsCmd( TclNewObj(resultObj); if (recurse) { const char **names; - size_t i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); + Tcl_Size i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); for (i=0 ; i 0) { Tcl_Free((void *)names); @@ -1431,7 +1431,7 @@ InfoClassMethodTypeCmd( goto unknownMethod; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1)); return TCL_OK; } @@ -1454,7 +1454,7 @@ InfoClassMixinsCmd( { Class *clsPtr, *mixinPtr; Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); @@ -1496,7 +1496,7 @@ InfoClassSubsCmd( { Class *clsPtr, *subclassPtr; Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; const char *pattern = NULL; if (objc != 2 && objc != 3) { @@ -1551,7 +1551,7 @@ InfoClassSupersCmd( { Class *clsPtr, *superPtr; Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "className"); @@ -1590,7 +1590,7 @@ InfoClassVariablesCmd( { Class *clsPtr; Tcl_Obj *resultObj; - size_t i; + Tcl_Size i; int isPrivate = 0; if (objc != 2 && objc != 3) { @@ -1663,7 +1663,7 @@ InfoObjectCallCmd( NULL); if (contextPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot construct any call chain", TCL_INDEX_NONE)); + "cannot construct any call chain", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, @@ -1708,7 +1708,7 @@ InfoClassCallCmd( callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD); if (callPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot construct any call chain", TCL_INDEX_NONE)); + "cannot construct any call chain", -1)); return TCL_ERROR; } Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr)); diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index b7fb34d85257..c3f6fc22c7a4 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -46,7 +46,7 @@ typedef struct Method { /* The type of method. If NULL, this is a * special flag record which is just used for * the setting of the flags field. */ - size_t refCount; + Tcl_Size refCount; void *clientData; /* Type-specific data. */ Tcl_Obj *namePtr; /* Name of the method. */ struct Object *declaringObjectPtr; @@ -83,7 +83,7 @@ typedef struct ProcedureMethod { * includes the argument definition and the * body bytecodes. */ int flags; /* Flags to control features. */ - size_t refCount; + Tcl_Size refCount; void *clientData; TclOO_PmCDDeleteProc *deleteClientdataProc; TclOO_PmCDCloneProc *cloneClientdataProc; @@ -149,9 +149,9 @@ typedef struct { */ #define LIST_STATIC(listType_t) \ - struct { size_t num; listType_t *list; } + struct { Tcl_Size num; listType_t *list; } #define LIST_DYNAMIC(listType_t) \ - struct { size_t num, size; listType_t *list; } + struct { Tcl_Size num, size; listType_t *list; } /* * These types are needed in function arguments. @@ -184,14 +184,14 @@ typedef struct Object { struct Class *classPtr; /* This is non-NULL for all classes, and NULL * for everything else. It points to the class * structure. */ - size_t refCount; /* Number of strong references to this object. + Tcl_Size refCount; /* Number of strong references to this object. * Note that there may be many more weak * references; this mechanism exists to * avoid Tcl_Preserve. */ int flags; - size_t creationEpoch; /* Unique value to make comparisons of objects + Tcl_Size creationEpoch; /* Unique value to make comparisons of objects * easier. */ - size_t epoch; /* Per-object epoch, incremented when the way + Tcl_Size epoch; /* Per-object epoch, incremented when the way * an object should resolve call chains is * changed. */ Tcl_HashTable *metadataPtr; /* Mapping from pointers to metadata type to @@ -329,7 +329,7 @@ typedef struct Class { */ typedef struct ThreadLocalData { - size_t nsCount; /* Epoch counter is used for keeping + Tcl_Size nsCount; /* Epoch counter is used for keeping * the values used in Tcl_Obj internal * representations sane. Must be thread-local * because Tcl_Objs can cross interpreter @@ -353,7 +353,7 @@ typedef struct Foundation { Tcl_Namespace *helpersNs; /* Namespace containing the commands that are * only valid when executing inside a * procedural method. */ - size_t epoch; /* Used to invalidate method chains when the + Tcl_Size epoch; /* Used to invalidate method chains when the * class structure changes. */ ThreadLocalData *tsdPtr; /* Counter so we can allocate a unique * namespace to each object. */ @@ -387,16 +387,16 @@ struct MInvoke { }; typedef struct CallChain { - size_t objectCreationEpoch; /* The object's creation epoch. Note that the + Tcl_Size objectCreationEpoch;/* The object's creation epoch. Note that the * object reference is not stored in the call * chain; it is in the call context. */ - size_t objectEpoch; /* Local (object structure) epoch counter + Tcl_Size objectEpoch; /* Local (object structure) epoch counter * snapshot. */ - size_t epoch; /* Global (class structure) epoch counter + Tcl_Size epoch; /* Global (class structure) epoch counter * snapshot. */ int flags; /* Assorted flags, see below. */ - size_t refCount; /* Reference count. */ - size_t numChain; /* Size of the call chain. */ + Tcl_Size refCount; /* Reference count. */ + Tcl_Size numChain; /* Size of the call chain. */ struct MInvoke *chain; /* Array of call chain entries. May point to * staticChain if the number of entries is * small. */ @@ -405,9 +405,9 @@ typedef struct CallChain { typedef struct CallContext { Object *oPtr; /* The object associated with this call. */ - size_t index; /* Index into the call chain of the currently + Tcl_Size index; /* Index into the call chain of the currently * executing method implementation. */ - size_t skip; /* Current number of arguments to skip; can + Tcl_Size skip; /* Current number of arguments to skip; can * vary depending on whether it is a direct * method call or a continuation via the * [next] command. */ @@ -505,8 +505,8 @@ MODULE_SCOPE Tcl_Method TclNewMethod(Tcl_Interp *interp, Tcl_Class cls, void *clientData); MODULE_SCOPE int TclNRNewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, - const char *nsNameStr, size_t objc, - Tcl_Obj *const *objv, size_t skip, + const char *nsNameStr, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip, Tcl_Object *objectPtr); MODULE_SCOPE Object * TclNewObjectInstanceCommon(Tcl_Interp *interp, Class *classPtr, @@ -544,8 +544,8 @@ MODULE_SCOPE int TclOOInvokeContext(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, - Tcl_ObjectContext context, size_t objc, - Tcl_Obj *const *objv, size_t skip); + Tcl_ObjectContext context, Tcl_Size objc, + Tcl_Obj *const *objv, Tcl_Size skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); @@ -578,7 +578,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); /* * A convenience macro for iterating through the lists used in the internal * memory management of objects. - * REQUIRES DECLARATION: size_t i; + * REQUIRES DECLARATION: Tcl_Size i; */ #define FOREACH(var,ary) \ @@ -590,7 +590,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); * A variation where the array is an array of structs. There's no issue with * possible NULLs; every element of the array will be iterated over and the * varable set to a pointer to each of those elements in turn. - * REQUIRES DECLARATION: size_t i; + * REQUIRES DECLARATION: Tcl_Size i; */ #define FOREACH_STRUCT(var,ary) \ diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index 53c2a6f3a5a0..730a73aa5b71 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -42,7 +42,7 @@ TCLAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, ProcedureMethod **pmPtrPtr); /* 5 */ TCLAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, - size_t objc, Tcl_Obj *const *objv, + Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ TCLAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); @@ -75,21 +75,21 @@ TCLAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, /* 11 */ TCLAPI int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, - int publicPrivate, size_t objc, + int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 12 */ TCLAPI void TclOOObjectSetFilters(Object *oPtr, - size_t numFilters, Tcl_Obj *const *filters); + Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */ TCLAPI void TclOOClassSetFilters(Tcl_Interp *interp, - Class *classPtr, size_t numFilters, + Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 14 */ -TCLAPI void TclOOObjectSetMixins(Object *oPtr, size_t numMixins, - Class *const *mixins); +TCLAPI void TclOOObjectSetMixins(Object *oPtr, + Tcl_Size numMixins, Class *const *mixins); /* 15 */ TCLAPI void TclOOClassSetMixins(Tcl_Interp *interp, - Class *classPtr, size_t numMixins, + Class *classPtr, Tcl_Size numMixins, Class *const *mixins); typedef struct TclOOIntStubs { @@ -101,17 +101,17 @@ typedef struct TclOOIntStubs { 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, void *clientData, Proc **procPtrPtr); /* 2 */ Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */ Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ - int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, size_t objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ + int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */ int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */ Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */ Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */ Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ - int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, size_t objc, Tcl_Obj *const *objv); /* 11 */ - void (*tclOOObjectSetFilters) (Object *oPtr, size_t numFilters, Tcl_Obj *const *filters); /* 12 */ - void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, size_t numFilters, Tcl_Obj *const *filters); /* 13 */ - void (*tclOOObjectSetMixins) (Object *oPtr, size_t numMixins, Class *const *mixins); /* 14 */ - void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, size_t numMixins, Class *const *mixins); /* 15 */ + int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, Tcl_Size objc, Tcl_Obj *const *objv); /* 11 */ + void (*tclOOObjectSetFilters) (Object *oPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 12 */ + void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numFilters, Tcl_Obj *const *filters); /* 13 */ + void (*tclOOObjectSetMixins) (Object *oPtr, Tcl_Size numMixins, Class *const *mixins); /* 14 */ + void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, Tcl_Size numMixins, Class *const *mixins); /* 15 */ } TclOOIntStubs; extern const TclOOIntStubs *tclOOIntStubsPtr; diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 2ac21b81d9de..34437c7eee33 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -18,7 +18,7 @@ /* * Structure used to help delay computing names of objects or classes for - * [info frame] until needed, making invokation faster in the normal case. + * [info frame] until needed, making invocation faster in the normal case. */ struct PNI { @@ -387,7 +387,7 @@ TclOONewBasicMethod( /* Name of the method, whether it is public, * and the function to implement it. */ { - Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, TCL_INDEX_NONE); + Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1); Tcl_IncrRefCount(namePtr); TclNewMethod(interp, (Tcl_Class) clsPtr, namePtr, @@ -421,7 +421,7 @@ TclOONewProcInstanceMethod( * structure's contents. NULL if caller is not * interested. */ { - size_t argsLen; + Tcl_Size argsLen; ProcedureMethod *pmPtr; Tcl_Method method; @@ -473,7 +473,7 @@ TclOONewProcMethod( * structure's contents. NULL if caller is not * interested. */ { - size_t argsLen; /* TCL_INDEX_NONE => delete argsObj before exit */ + Tcl_Size argsLen; /* TCL_INDEX_NONE => delete argsObj before exit */ ProcedureMethod *pmPtr; const char *procName; Tcl_Method method; @@ -1074,7 +1074,7 @@ ProcedureMethodCompiledVarConnect( PrivateVariableMapping *privateVar; Tcl_HashEntry *hPtr; int isNew, cacheIt; - size_t i, varLen, len; + Tcl_Size i, varLen, len; const char *match, *varName; /* @@ -1188,7 +1188,7 @@ static int ProcedureMethodCompiledVarResolver( TCL_UNUSED(Tcl_Interp *), const char *varName, - size_t length, + Tcl_Size length, TCL_UNUSED(Tcl_Namespace *), Tcl_ResolvedVarInfo **rPtrPtr) { @@ -1269,7 +1269,7 @@ MethodErrorHandler( TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/) /* We pull the method name out of context instead of from argument */ { - size_t nameLen, objectNameLen; + Tcl_Size nameLen, objectNameLen; CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData; Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const char *objectName, *kindName, *methodName = @@ -1305,7 +1305,7 @@ ConstructorErrorHandler( Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - size_t objectNameLen; + Tcl_Size objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; @@ -1335,7 +1335,7 @@ DestructorErrorHandler( Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; Object *declarerPtr; const char *objectName, *kindName; - size_t objectNameLen; + Tcl_Size objectNameLen; if (mPtr->declaringObjectPtr != NULL) { declarerPtr = mPtr->declaringObjectPtr; @@ -1410,7 +1410,7 @@ CloneProcedureMethod( TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, - Tcl_NewStringObj(localPtr->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); } @@ -1473,7 +1473,7 @@ TclOONewForwardInstanceMethod( Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { - size_t prefixLen; + Tcl_Size prefixLen; ForwardMethod *fmPtr; if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { @@ -1481,7 +1481,7 @@ TclOONewForwardInstanceMethod( } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method forward prefix must be non-empty", TCL_INDEX_NONE)); + "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } @@ -1512,7 +1512,7 @@ TclOONewForwardMethod( Tcl_Obj *prefixObj) /* List of arguments that form the command * prefix to forward to. */ { - size_t prefixLen; + Tcl_Size prefixLen; ForwardMethod *fmPtr; if (TclListObjLengthM(interp, prefixObj, &prefixLen) != TCL_OK) { @@ -1520,7 +1520,7 @@ TclOONewForwardMethod( } if (prefixLen < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "method forward prefix must be non-empty", TCL_INDEX_NONE)); + "method forward prefix must be non-empty", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL); return NULL; } @@ -1554,7 +1554,7 @@ InvokeForwardMethod( CallContext *contextPtr = (CallContext *) context; ForwardMethod *fmPtr = (ForwardMethod *)clientData; Tcl_Obj **argObjs, **prefixObjs; - size_t numPrefixes, skip = contextPtr->skip; + Tcl_Size numPrefixes, skip = contextPtr->skip; int len; /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 16b9ca19a8fb..0c9c4052aa55 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -80,7 +80,7 @@ typedef struct { Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj * generated by a call to the function * TclSubstTokens() from a literal text - * where bs+nl sequences occured in it, if + * where bs+nl sequences occurred in it, if * any. I.e. this table keeps track of * invisible and stripped continuation lines. * Its keys are Tcl_Obj pointers, the values @@ -111,14 +111,14 @@ static ThreadSpecificData *TclGetContLineTable(void); */ typedef struct PendingObjData { - int deletionCount; /* Count of the number of invokations of + int deletionCount; /* Count of the number of invocations of * TclFreeObj() are on the stack (at least * conceptually; many are actually expanded * macros). */ Tcl_Obj *deletionStack; /* Stack of objects that have had TclFreeObj() * invoked upon them but which can't be * deleted yet because they are in a nested - * invokation of TclFreeObj(). By postponing + * invocation of TclFreeObj(). By postponing * this way, we limit the maximum overall C * stack depth when deleting a complex object. * The down-side is that we alter the overall @@ -329,12 +329,12 @@ typedef struct ResolvedCmdName { * it's possible that the cmd's containing * namespace was deleted and a new one created * at the same address). */ - size_t refNsCmdEpoch; /* Value of the referencing namespace's + Tcl_Size refNsCmdEpoch; /* Value of the referencing namespace's * cmdRefEpoch when the pointer was cached. * Before using the cached pointer, we check * if the namespace's epoch was incremented; * if so, this cached pointer is invalid. */ - size_t cmdEpoch; /* Value of the command's cmdEpoch when this + Tcl_Size cmdEpoch; /* Value of the command's cmdEpoch when this * pointer was cached. Before using the cached * pointer, we check if the cmd's epoch was * incremented; if so, the cmd was renamed, @@ -346,6 +346,18 @@ typedef struct ResolvedCmdName { * structure can be freed when refCount * becomes zero. */ } ResolvedCmdName; + +#ifdef TCL_MEM_DEBUG +/* + * Filler matches the value used for filling freed memory in tclCkalloc. + * On 32-bit systems, the ref counts do not cross 0x7fffffff. On 64-bit + * implementations, ref counts will never reach this value (unless explicitly + * incremented without actual references!) + */ +#define FREEDREFCOUNTFILLER \ + (Tcl_Size)(sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8) +#endif + /* *------------------------------------------------------------------------- @@ -538,7 +550,7 @@ TclGetContLineTable(void) ContLineLoc * TclContinuationsEnter( Tcl_Obj *objPtr, - size_t num, + Tcl_Size num, int *loc) { int newEntry; @@ -557,7 +569,7 @@ TclContinuationsEnter( * the switch command is identical, mapping them all to the same * literal. An interesting result of this is that the number and * locations (offset) of invisible continuation lines in the literal - * are the same for all occurences. + * are the same for all occurrences. * * Note that while reusing the existing entry is possible it requires * the same actions as for a new entry because we have to copy the @@ -605,7 +617,7 @@ TclContinuationsEnterDerived( int start, int *clNext) { - size_t length; + Tcl_Size length; int end, num; int *wordCLLast = clNext; @@ -848,7 +860,7 @@ Tcl_AppendAllObjTypes( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - size_t numElems; + Tcl_Size numElems; /* * Get the test for a valid list out of the way first. @@ -867,7 +879,7 @@ Tcl_AppendAllObjTypes( for (hPtr = Tcl_FirstHashEntry(&typeTable, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), TCL_INDEX_NONE)); + Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), -1)); } Tcl_MutexUnlock(&tableMutex); return TCL_OK; @@ -1016,7 +1028,7 @@ TclDbDumpActiveObjects( * * Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is * enabled. This function will initialize the members of a Tcl_Obj - * struct. Initilization would be done inline via the TclNewObj macro + * struct. Initialization would be done inline via the TclNewObj macro * when compiling without TCL_MEM_DEBUG. * * Results: @@ -1313,7 +1325,7 @@ TclFreeObj( * either from 1 to 0, or from 0 to -1. Falling from -1 to -2, though, * and so on, is always a sign of a botch in the caller. */ - if (objPtr->refCount == (size_t)-2) { + if (objPtr->refCount == (Tcl_Size)-2) { Tcl_Panic("Reference count for %p was negative", objPtr); } /* @@ -1368,7 +1380,7 @@ TclFreeObj( * We have to access it using the low-level call and then check for * validity. This function can be called after TclFinalizeThreadData() has * already killed the thread-global data structures. Performing - * TCL_TSD_INIT will leave us with an un-initialized memory block upon + * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ @@ -1459,7 +1471,7 @@ TclFreeObj( * We have to access it using the low-level call and then check for * validity. This function can be called after TclFinalizeThreadData() has * already killed the thread-global data structures. Performing - * TCL_TSD_INIT will leave us with an un-initialized memory block upon + * TCL_TSD_INIT will leave us with an uninitialized memory block upon * which we crash (if we where to access the uninitialized hashtable). */ @@ -1653,12 +1665,12 @@ Tcl_GetString( *---------------------------------------------------------------------- */ -#undef TclGetStringFromObj +#if !defined(TCL_NO_DEPRECATED) char * TclGetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - int *lengthPtr) /* If non-NULL, the location where the string + void *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -1690,19 +1702,20 @@ TclGetStringFromObj( if (lengthPtr != NULL) { if (objPtr->length > INT_MAX) { Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr" - "cannot handle such long strings. Please use 'size_t'"); + " cannot handle such long strings. Please use 'Tcl_Size'"); } - *lengthPtr = (int)objPtr->length; + *(int *)lengthPtr = (int)objPtr->length; } return objPtr->bytes; } +#endif /* !defined(TCL_NO_DEPRECATED) */ #undef Tcl_GetStringFromObj char * Tcl_GetStringFromObj( Tcl_Obj *objPtr, /* Object whose string rep byte pointer should * be returned. */ - size_t *lengthPtr) /* If non-NULL, the location where the string + Tcl_Size *lengthPtr) /* If non-NULL, the location where the string * rep's byte array length should * be stored. * If NULL, no length is stored. */ { @@ -2126,13 +2139,13 @@ TclSetBooleanFromAny( badBoolean: if (interp != NULL) { - size_t length; + Tcl_Size length; const char *str = Tcl_GetStringFromObj(objPtr, &length); Tcl_Obj *msg; TclNewLiteralStringObj(msg, "expected boolean value but got \""); Tcl_AppendLimitedToObj(msg, str, length, 50, ""); - Tcl_AppendToObj(msg, "\"", TCL_INDEX_NONE); + Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL); } @@ -2145,7 +2158,7 @@ ParseBoolean( { int newBool; char lowerCase[6]; - size_t i, length; + Tcl_Size i, length; const char *str = Tcl_GetStringFromObj(objPtr, &length); if ((length == 0) || (length > 5)) { @@ -2421,7 +2434,7 @@ Tcl_GetDoubleFromObj( if (isnan(objPtr->internalRep.doubleValue)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "floating point value is Not a Number", TCL_INDEX_NONE)); + "floating point value is Not a Number", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN", NULL); } @@ -2553,7 +2566,7 @@ Tcl_GetIntFromObj( if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; @@ -2718,7 +2731,7 @@ Tcl_GetLongFromObj( #endif if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_Obj *msg = Tcl_NewStringObj(s, TCL_INDEX_NONE); + Tcl_Obj *msg = Tcl_NewStringObj(s, -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); @@ -2953,7 +2966,7 @@ Tcl_GetWideIntFromObj( } if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_Obj *msg = Tcl_NewStringObj(s, TCL_INDEX_NONE); + Tcl_Obj *msg = Tcl_NewStringObj(s, -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); @@ -3037,7 +3050,7 @@ Tcl_GetWideUIntFromObj( if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_Obj *msg = Tcl_NewStringObj(s, TCL_INDEX_NONE); + Tcl_Obj *msg = Tcl_NewStringObj(s, -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); @@ -3119,6 +3132,31 @@ TclGetWideBitsFromObj( return TCL_ERROR; } +/* + *---------------------------------------------------------------------- + * + * Tcl_GetSizeIntFromObj -- + * + * Attempt to return a Tcl_Size from the Tcl object "objPtr". + * + * Results: + * TCL_OK - the converted Tcl_Size value is stored in *sizePtr + * TCL_ERROR - the error message is stored in interp + * + * Side effects: + * The function may free up any existing internal representation. + * + *---------------------------------------------------------------------- + */ +int +Tcl_GetSizeIntFromObj( + Tcl_Interp *interp, /* Used for error reporting if not NULL. */ + Tcl_Obj *objPtr, /* The object from which to get a int. */ + Tcl_Size *sizePtr) /* Place to store resulting int. */ +{ + return TclGetSizeIntFromObj(interp, objPtr, sizePtr); +} + /* *---------------------------------------------------------------------- * @@ -3157,7 +3195,7 @@ FreeBignum( * None. * * Side effects: - * The destination object receies a copy of the source object + * The destination object receives a copy of the source object * *---------------------------------------------------------------------- */ @@ -3236,7 +3274,7 @@ UpdateStringOfBignum( * * Tcl_NewBignumObj -- * - * Creates an initializes a bignum object. + * Creates and initializes a bignum object. * * Results: * Returns the newly created object. @@ -3433,7 +3471,7 @@ Tcl_GetBignumFromObj( * * Side effects: * A copy of bignum is stored in *bignumValue, which is expected to be - * uninitialized or cleared. If conversion fails, an the 'interp' + * uninitialized or cleared. If conversion fails and the 'interp' * argument is not NULL, an error message is stored in the interpreter * result. * @@ -3608,7 +3646,7 @@ int Tcl_GetNumber( Tcl_Interp *interp, const char *bytes, - size_t numBytes, + Tcl_Size numBytes, void **clientDataPtr, int *typePtr) { @@ -3622,7 +3660,7 @@ Tcl_GetNumber( bytes = &tclEmptyString; numBytes = 0; } - if (numBytes == (size_t)TCL_INDEX_NONE) { + if (numBytes < 0) { numBytes = strlen(bytes); } if (numBytes > INT_MAX) { @@ -3736,7 +3774,7 @@ Tcl_DbIncrRefCount( int line) /* Line number in the source file; used for * debugging. */ { - if (objPtr->refCount == 0x61616161) { + if (objPtr->refCount == FREEDREFCOUNTFILLER) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("incrementing refCount of previously disposed object"); @@ -3809,7 +3847,7 @@ Tcl_DbDecrRefCount( int line) /* Line number in the source file; used for * debugging. */ { - if (objPtr->refCount == 0x61616161) { + if (objPtr->refCount == FREEDREFCOUNTFILLER) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("decrementing refCount of previously disposed object"); @@ -3891,7 +3929,7 @@ Tcl_DbIsShared( #endif { #ifdef TCL_MEM_DEBUG - if (objPtr->refCount == 0x61616161) { + if (objPtr->refCount == FREEDREFCOUNTFILLER) { fprintf(stderr, "file = %s, line = %d\n", file, line); fflush(stderr); Tcl_Panic("checking whether previously disposed object is shared"); @@ -4107,7 +4145,7 @@ TclHashObjKey( void *keyPtr) /* Key from which to compute hash value. */ { Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr; - size_t length; + Tcl_Size length; const char *string = Tcl_GetStringFromObj(objPtr, &length); TCL_HASH_TYPE result = 0; @@ -4248,7 +4286,7 @@ Tcl_GetCommandFromObj( * None. * * Side effects: - * The object's old internal rep is freed. It's string rep is not + * The object's old internal rep is freed. Its string rep is not * changed. The refcount in the Command structure is incremented to keep * it from being freed if the command is later deleted until * TclNRExecuteByteCode has a chance to recognize that it was deleted. @@ -4539,12 +4577,12 @@ Tcl_RepresentationCmd( } if (objv[1]->bytes) { - Tcl_AppendToObj(descObj, ", string representation \"", TCL_INDEX_NONE); + Tcl_AppendToObj(descObj, ", string representation \"", -1); Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length, 16, "..."); - Tcl_AppendToObj(descObj, "\"", TCL_INDEX_NONE); + Tcl_AppendToObj(descObj, "\"", -1); } else { - Tcl_AppendToObj(descObj, ", no string representation", TCL_INDEX_NONE); + Tcl_AppendToObj(descObj, ", no string representation", -1); } Tcl_SetObjResult(interp, descObj); diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index 7d3bc7b65819..7a4a962131d9 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -55,7 +55,7 @@ LocateTargetAddresses( { unsigned char *currentInstPtr, *targetInstPtr; int isNew; - size_t i; + Tcl_Size i; Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; @@ -232,7 +232,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); - size_t numBytes; + Tcl_Size numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { @@ -247,7 +247,7 @@ ConvertZeroEffectToNOP( && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); - size_t numBytes; + Tcl_Size numBytes; (void) Tcl_GetStringFromObj(litPtr, &numBytes); if (numBytes == 0) { diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 1d7e992cf754..5a05c242e107 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -66,7 +66,7 @@ Tcl_SetPanicProc( */ /* - * The following comment is here so that Coverity's static analizer knows that + * The following comment is here so that Coverity's static analyzer knows that * a Tcl_Panic() call can never return and avoids lots of false positives. */ diff --git a/generic/tclParse.c b/generic/tclParse.c index 75ffa26fd051..d8b40e4de3d0 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -120,16 +120,16 @@ const unsigned char tclCharTypeTable[] = { * Prototypes for local functions defined in this file: */ -static int CommandComplete(const char *script, size_t numBytes); -static size_t ParseComment(const char *src, size_t numBytes, +static int CommandComplete(const char *script, Tcl_Size numBytes); +static Tcl_Size ParseComment(const char *src, Tcl_Size numBytes, Tcl_Parse *parsePtr); -static int ParseTokens(const char *src, size_t numBytes, int mask, +static int ParseTokens(const char *src, Tcl_Size numBytes, int mask, int flags, Tcl_Parse *parsePtr); -static size_t ParseWhiteSpace(const char *src, size_t numBytes, +static Tcl_Size ParseWhiteSpace(const char *src, Tcl_Size numBytes, int *incompletePtr, char *typePtr); -static size_t ParseAllWhiteSpace(const char *src, size_t numBytes, +static Tcl_Size ParseAllWhiteSpace(const char *src, Tcl_Size numBytes, int *incompletePtr); -static int ParseHex(const char *src, size_t numBytes, +static int ParseHex(const char *src, Tcl_Size numBytes, int *resultPtr); /* @@ -152,7 +152,7 @@ void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ const char *start, /* Start of string to be parsed. */ - size_t numBytes, /* Total number of bytes in string. If -1, + Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the script consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Points to struct to initialize */ @@ -198,7 +198,7 @@ Tcl_ParseCommand( * NULL, then no error message is provided. */ const char *start, /* First character of string containing one or * more Tcl commands. */ - size_t numBytes, /* Total number of bytes in string. If -1, + Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the script consists of all bytes up to the * first null character. */ int nested, /* Non-zero means this is a nested command: @@ -214,21 +214,21 @@ Tcl_ParseCommand( * command. */ char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ - int wordIndex; /* Index of word token for current word. */ + Tcl_Size wordIndex; /* Index of word token for current word. */ int terminators; /* CHAR_TYPE bits that indicate the end of a * command. */ const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ - size_t scanned; + Tcl_Size scanned; - if (numBytes == TCL_INDEX_NONE && start) { + if (numBytes < 0 && start) { numBytes = strlen(start); } TclParseInit(interp, start, numBytes, parsePtr); if ((start == NULL) && (numBytes != 0)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can't parse a NULL pointer", TCL_INDEX_NONE)); + "can't parse a NULL pointer", -1)); } return TCL_ERROR; } @@ -282,13 +282,13 @@ Tcl_ParseCommand( if (src[-1] == '"') { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-quote", TCL_INDEX_NONE)); + "extra characters after close-quote", -1)); } parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA; } else { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "extra characters after close-brace", TCL_INDEX_NONE)); + "extra characters after close-brace", -1)); } parsePtr->errorType = TCL_PARSE_BRACE_EXTRA; } @@ -327,7 +327,7 @@ Tcl_ParseCommand( src = termPtr; numBytes = parsePtr->end - src; } else if (*src == '{') { - int expIdx = wordIndex + 1; + Tcl_Size expIdx = wordIndex + 1; Tcl_Token *expPtr; if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1, @@ -345,7 +345,7 @@ Tcl_ParseCommand( expPtr = &parsePtr->tokenPtr[expIdx]; if ((0 == expandWord) /* Haven't seen prefix already */ - && (expIdx + 1 == (int)parsePtr->numTokens) + && (expIdx + 1 == parsePtr->numTokens) /* Only one token */ && (((1 == expPtr->size) /* Same length as prefix */ @@ -380,9 +380,9 @@ Tcl_ParseCommand( tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->size = src - tokenPtr->start; - tokenPtr->numComponents = (int)parsePtr->numTokens - (wordIndex + 1); + tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1); if (expandWord) { - size_t i; + Tcl_Size i; int isLiteral = 1; /* @@ -407,7 +407,8 @@ Tcl_ParseCommand( } if (isLiteral) { - int elemCount = 0, code = TCL_OK, literal = 1; + Tcl_Size elemCount = 0; + int code = TCL_OK, literal = 1; const char *nextElem, *listEnd, *elemStart; /* @@ -429,7 +430,7 @@ Tcl_ParseCommand( */ while (nextElem < listEnd) { - size_t size; + Tcl_Size size; code = TclFindElement(NULL, nextElem, listEnd - nextElem, &elemStart, &nextElem, &size, &literal); @@ -471,8 +472,8 @@ Tcl_ParseCommand( */ const char *listStart; - int growthNeeded = wordIndex + 2*elemCount - - (int)parsePtr->numTokens; + Tcl_Size growthNeeded = wordIndex + 2*elemCount + - parsePtr->numTokens; parsePtr->numWords += elemCount - 1; if (growthNeeded > 0) { @@ -621,10 +622,10 @@ TclIsBareword( *---------------------------------------------------------------------- */ -static size_t +static Tcl_Size ParseWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of bytes to scan. */ + Tcl_Size numBytes, /* Max number of bytes to scan. */ int *incompletePtr, /* Set this boolean memory to true if parsing * indicates an incomplete command. */ char *typePtr) /* Points to location to store character type @@ -675,17 +676,17 @@ ParseWhiteSpace( *---------------------------------------------------------------------- */ -static size_t +static Tcl_Size ParseAllWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of byes to scan */ + Tcl_Size numBytes, /* Max number of byes to scan */ int *incompletePtr) /* Set true if parse is incomplete. */ { char type; const char *p = src; do { - size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); + Tcl_Size scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type); p += scanned; numBytes -= scanned; @@ -693,10 +694,10 @@ ParseAllWhiteSpace( return (p-src); } -size_t +Tcl_Size TclParseAllWhiteSpace( const char *src, /* First character to parse. */ - size_t numBytes) /* Max number of byes to scan */ + Tcl_Size numBytes) /* Max number of byes to scan */ { int dummy; return ParseAllWhiteSpace(src, numBytes, &dummy); @@ -727,7 +728,7 @@ TclParseAllWhiteSpace( int ParseHex( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of byes to scan */ + Tcl_Size numBytes, /* Max number of byes to scan */ int *resultPtr) /* Points to storage provided by caller where * the character resulting from the * conversion is to be written. */ @@ -781,10 +782,10 @@ ParseHex( int TclParseBackslash( - const char *src, /* Points to the backslash character of a a + const char *src, /* Points to the backslash character of a * backslash sequence. */ - size_t numBytes, /* Max number of bytes to scan. */ - size_t *readPtr, /* NULL, or points to storage where the number + Tcl_Size numBytes, /* Max number of bytes to scan. */ + Tcl_Size *readPtr, /* NULL, or points to storage where the number * of bytes scanned should be written. */ char *dst) /* NULL, or points to buffer where the UTF-8 * encoding of the backslash sequence is to be @@ -793,7 +794,7 @@ TclParseBackslash( const char *p = src+1; int unichar; int result; - size_t count; + Tcl_Size count; char buf[4] = ""; if (numBytes == 0) { @@ -981,10 +982,10 @@ TclParseBackslash( *---------------------------------------------------------------------- */ -static size_t +static Tcl_Size ParseComment( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of bytes to scan. */ + Tcl_Size numBytes, /* Max number of bytes to scan. */ Tcl_Parse *parsePtr) /* Information about parse in progress. * Updated if parsing indicates an incomplete * command. */ @@ -993,7 +994,7 @@ ParseComment( int incomplete = parsePtr->incomplete; while (numBytes) { - size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); + Tcl_Size scanned = ParseAllWhiteSpace(p, numBytes, &incomplete); p += scanned; numBytes -= scanned; @@ -1057,7 +1058,7 @@ ParseComment( static int ParseTokens( const char *src, /* First character to parse. */ - size_t numBytes, /* Max number of bytes to scan. */ + Tcl_Size numBytes, /* Max number of bytes to scan. */ int mask, /* Specifies when to stop parsing. The parse * stops at the first unquoted character whose * CHAR_TYPE contains any of the bits in @@ -1179,7 +1180,7 @@ ParseTokens( if (numBytes == 0) { if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-bracket", TCL_INDEX_NONE)); + "missing close-bracket", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_BRACKET; parsePtr->term = tokenPtr->start; @@ -1335,7 +1336,7 @@ Tcl_ParseVarName( * NULL, then no error message is provided. */ const char *start, /* Start of variable substitution string. * First character must be "$". */ - size_t numBytes, /* Total number of bytes in string. If -1, + Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, /* Structure to fill in with information about @@ -1350,7 +1351,7 @@ Tcl_ParseVarName( int varIndex; unsigned array; - if (numBytes == TCL_INDEX_NONE && start) { + if (numBytes < 0 && start) { numBytes = strlen(start); } if (!append) { @@ -1425,7 +1426,7 @@ Tcl_ParseVarName( if (numBytes == 0) { if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace for variable name", TCL_INDEX_NONE)); + "missing close-brace for variable name", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; parsePtr->term = tokenPtr->start-1; @@ -1483,7 +1484,7 @@ Tcl_ParseVarName( if (parsePtr->term == src+numBytes){ if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing )", TCL_INDEX_NONE)); + "missing )", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_PAREN; parsePtr->term = src; @@ -1492,7 +1493,7 @@ Tcl_ParseVarName( } else if ((*parsePtr->term != ')')){ if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "invalid character in array index", TCL_INDEX_NONE)); + "invalid character in array index", -1)); } parsePtr->errorType = TCL_PARSE_SYNTAX; parsePtr->term = src; @@ -1633,7 +1634,7 @@ Tcl_ParseBraces( * NULL, then no error message is provided. */ const char *start, /* Start of string enclosed in braces. The * first character must be {'. */ - size_t numBytes, /* Total number of bytes in string. If -1, + Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, @@ -1651,9 +1652,9 @@ Tcl_ParseBraces( Tcl_Token *tokenPtr; const char *src; int startIndex, level; - size_t length; + Tcl_Size length; - if (numBytes == TCL_INDEX_NONE && start) { + if (numBytes < 0 && start) { numBytes = strlen(start); } if (!append) { @@ -1765,7 +1766,7 @@ Tcl_ParseBraces( } Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing close-brace", TCL_INDEX_NONE)); + "missing close-brace", -1)); /* * Guess if the problem is due to comments by searching the source string @@ -1788,7 +1789,7 @@ Tcl_ParseBraces( case '#' : if (openBrace && TclIsSpaceProcM(src[-1])) { Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp), - ": possible unbalanced brace in comment", TCL_INDEX_NONE); + ": possible unbalanced brace in comment", -1); goto error; } break; @@ -1835,7 +1836,7 @@ Tcl_ParseQuotedString( * NULL, then no error message is provided. */ const char *start, /* Start of the quoted string. The first * character must be '"'. */ - size_t numBytes, /* Total number of bytes in string. If -1, + Tcl_Size numBytes, /* Total number of bytes in string. If -1, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr, @@ -1850,7 +1851,7 @@ Tcl_ParseQuotedString( * the quoted string's terminating close-quote * if the parse succeeds. */ { - if (numBytes == TCL_INDEX_NONE && start) { + if (numBytes < 0 && start) { numBytes = strlen(start); } if (!append) { @@ -1867,7 +1868,7 @@ Tcl_ParseQuotedString( if (*parsePtr->term != '"') { if (parsePtr->interp != NULL) { Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj( - "missing \"", TCL_INDEX_NONE)); + "missing \"", -1)); } parsePtr->errorType = TCL_PARSE_MISSING_QUOTE; parsePtr->term = start; @@ -1916,12 +1917,12 @@ void TclSubstParse( Tcl_Interp *interp, const char *bytes, - size_t numBytes, + Tcl_Size numBytes, int flags, Tcl_Parse *parsePtr, Tcl_InterpState *statePtr) { - size_t length = numBytes; + Tcl_Size length = numBytes; const char *p = bytes; TclParseInit(interp, p, length, parsePtr); @@ -2115,12 +2116,12 @@ TclSubstTokens( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - size_t count, /* Number of tokens to consider at tokenPtr. + Tcl_Size count, /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ int *tokensLeftPtr, /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ - size_t line, /* The line the script starts on. */ + Tcl_Size line, /* The line the script starts on. */ int *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set by * EvalEx() to properly handle [...]-nested @@ -2143,7 +2144,7 @@ TclSubstTokens( int code = TCL_OK; #define NUM_STATIC_POS 20 int isLiteral; - size_t i, maxNumCL, numCL, adjust; + Tcl_Size i, maxNumCL, numCL, adjust; int *clPosition = NULL; Interp *iPtr = (Interp *) interp; int inFile = iPtr->evalFlags & TCL_EVAL_FILE; @@ -2159,9 +2160,9 @@ TclSubstTokens( */ /* - * For the handling of continuation lines in literals we first check if - * this is actually a literal. For if not we can forego the additional - * processing. Otherwise we pre-allocate a small table to store the + * For the handling of continuation lines in literals, first check if + * this is actually a literal. If not then forego the additional + * processing. Otherwise preallocate a small table to store the * locations of all continuation lines we find in this literal, if any. * The table is extended if needed. */ @@ -2219,7 +2220,7 @@ TclSubstTokens( if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && (tokenPtr->start[1] == '\n')) { if (isLiteral) { - size_t clPos; + Tcl_Size clPos; if (result == 0) { clPos = 0; @@ -2248,7 +2249,7 @@ TclSubstTokens( * Test cases: info-30.{6,8,9} */ - size_t theline; + Tcl_Size theline; TclAdvanceContinuations(&line, &clNextOuter, tokenPtr->start - outerScript); @@ -2425,7 +2426,7 @@ TclSubstTokens( static int CommandComplete( const char *script, /* Script to check. */ - size_t numBytes) /* Number of bytes in script. */ + Tcl_Size numBytes) /* Number of bytes in script. */ { Tcl_Parse parse; const char *p, *end; @@ -2499,7 +2500,7 @@ TclObjCommandComplete( Tcl_Obj *objPtr) /* Points to object holding script to * check. */ { - size_t length; + Tcl_Size length; const char *script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index b14fd8afedbf..abf9d6b41799 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -25,7 +25,7 @@ static void DupFsPathInternalRep(Tcl_Obj *srcPtr, static void FreeFsPathInternalRep(Tcl_Obj *pathPtr); static void UpdateStringOfFsPath(Tcl_Obj *pathPtr); static int SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr); -static size_t FindSplitPos(const char *path, int separator); +static Tcl_Size FindSplitPos(const char *path, int separator); static int IsSeparatorOrNull(int ch); static Tcl_Obj * GetExtension(Tcl_Obj *pathPtr); static int MakePathFromNormalized(Tcl_Interp *interp, @@ -206,7 +206,7 @@ TclFSNormalizeAbsolutePath( /* * Need to skip '.' in the path. */ - size_t curLen; + Tcl_Size curLen; if (retVal == NULL) { const char *path = TclGetString(pathPtr); @@ -226,7 +226,7 @@ TclFSNormalizeAbsolutePath( } if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) { Tcl_Obj *linkObj; - size_t curLen; + Tcl_Size curLen; char *linkStr; /* @@ -305,7 +305,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - size_t i; + Tcl_Size i; for (i = 0; i < curLen; i++) { if (linkStr[i] == '\\') { @@ -385,7 +385,7 @@ TclFSNormalizeAbsolutePath( */ if (tclPlatform == TCL_PLATFORM_WINDOWS) { - size_t len; + Tcl_Size len; const char *path = Tcl_GetStringFromObj(retVal, &len); if (len == 2 && path[0] != 0 && path[1] == ':') { @@ -477,7 +477,7 @@ Tcl_PathType TclFSGetPathType( Tcl_Obj *pathPtr, const Tcl_Filesystem **filesystemPtrPtr, - size_t *driveNameLengthPtr) + Tcl_Size *driveNameLengthPtr) { FsPath *fsPathPtr; @@ -559,7 +559,7 @@ TclPathPart( * the standardPath code. */ - size_t numBytes; + Tcl_Size numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { @@ -596,7 +596,7 @@ TclPathPart( * we don't, and instead just use the standardPath code. */ - size_t numBytes; + Tcl_Size numBytes; const char *rest = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes); if (strchr(rest, '/') != NULL) { @@ -624,7 +624,7 @@ TclPathPart( return GetExtension(fsPathPtr->normPathPtr); case TCL_PATH_ROOT: { const char *fileName, *extension; - size_t length; + Tcl_Size length; fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &length); @@ -667,7 +667,7 @@ TclPathPart( goto standardPath; } } else { - size_t splitElements; + Tcl_Size splitElements; Tcl_Obj *splitPtr, *resultPtr; standardPath: @@ -675,7 +675,7 @@ TclPathPart( if (portion == TCL_PATH_EXTENSION) { return GetExtension(pathPtr); } else if (portion == TCL_PATH_ROOT) { - size_t length; + Tcl_Size length; const char *fileName, *extension; fileName = Tcl_GetStringFromObj(pathPtr, &length); @@ -751,7 +751,7 @@ GetExtension( if (extension == NULL) { TclNewObj(ret); } else { - ret = Tcl_NewStringObj(extension, TCL_INDEX_NONE); + ret = Tcl_NewStringObj(extension, -1); } Tcl_IncrRefCount(ret); return ret; @@ -795,17 +795,17 @@ Tcl_Obj * Tcl_FSJoinPath( Tcl_Obj *listObj, /* Path elements to join, may have a zero * reference count. */ - size_t elements) /* Number of elements to use (-1 = all) */ + Tcl_Size elements) /* Number of elements to use (-1 = all) */ { Tcl_Obj *res; - size_t objc; + Tcl_Size objc; Tcl_Obj **objv; if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) { return NULL; } - elements = ((elements != TCL_INDEX_NONE) && (elements <= objc)) ? elements : objc; + elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; TclListObjGetElementsM(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; @@ -813,13 +813,13 @@ Tcl_FSJoinPath( Tcl_Obj * TclJoinPath( - size_t elements, /* Number of elements to use */ + Tcl_Size elements, /* Number of elements to use */ Tcl_Obj * const objv[], /* Path elements to join */ int forceRelative) /* If non-zero, assume all more paths are - * relative (e. g. simple normalization) */ + * relative (e.g. simple normalization) */ { Tcl_Obj *res = NULL; - size_t i; + Tcl_Size i; const Tcl_Filesystem *fsPtr = NULL; if (elements == 0) { @@ -856,7 +856,7 @@ TclJoinPath( TclGetPathType(tailObj, NULL, NULL, NULL); if (type == TCL_PATH_RELATIVE) { const char *str; - size_t len; + Tcl_Size len; str = Tcl_GetStringFromObj(tailObj, &len); if (len == 0) { @@ -870,7 +870,7 @@ TclJoinPath( } /* - * If it doesn't begin with '.' and is a unix path or it a + * If it doesn't begin with '.' and is a Unix path or it a * windows path without backslashes, then we can be very * efficient here. (In fact even a windows path with * backslashes can be joined efficiently, but the path object @@ -923,8 +923,8 @@ TclJoinPath( assert ( res == NULL ); for (i = 0; i < elements; i++) { - size_t driveNameLength; - size_t strEltLen, length; + Tcl_Size driveNameLength; + Tcl_Size strEltLen, length; Tcl_PathType type; char *strElt, *ptr; Tcl_Obj *driveName = NULL; @@ -1166,7 +1166,7 @@ IsSeparatorOrNull( * of the end of the string. */ -static size_t +static Tcl_Size FindSplitPos( const char *path, int separator) @@ -1220,7 +1220,7 @@ Tcl_Obj * TclNewFSPathObj( Tcl_Obj *dirPtr, const char *addStrRep, - size_t len) + Tcl_Size len) { FsPath *fsPathPtr; Tcl_Obj *pathPtr; @@ -1273,7 +1273,7 @@ TclNewFSPathObj( * things as needing more aggressive normalization that don't actually * need it. No harm done. */ - for (p = addStrRep; len+1 > 1; p++, len--) { + for (p = addStrRep; len > 0; p++, len--) { switch (state) { case 0: /* So far only "." since last dirsep or start */ switch (*p) { @@ -1317,7 +1317,7 @@ AppendPath( { const char *bytes; Tcl_Obj *copy = Tcl_DuplicateObj(head); - size_t length; + Tcl_Size length; /* * This is likely buggy when dealing with virtual filesystem drivers @@ -1364,7 +1364,7 @@ TclFSMakePathRelative( Tcl_Obj *pathPtr, /* The path we have. */ Tcl_Obj *cwdPtr) /* Make it relative to this. */ { - size_t cwdLen, len; + Tcl_Size cwdLen, len; const char *tempStr; Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(pathPtr, &fsPathType); @@ -1632,7 +1632,7 @@ Tcl_FSGetTranslatedStringPath( Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr); if (transPtr != NULL) { - size_t len; + Tcl_Size len; const char *orig = Tcl_GetStringFromObj(transPtr, &len); char *result = (char *)Tcl_Alloc(len+1); @@ -1682,7 +1682,7 @@ Tcl_FSGetNormalizedPath( */ Tcl_Obj *dir, *copy; - size_t tailLen, cwdLen; + Tcl_Size tailLen, cwdLen; int pathType; pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); @@ -1784,7 +1784,7 @@ Tcl_FSGetNormalizedPath( } fsPathPtr = PATHOBJ(pathPtr); } else if (fsPathPtr->normPathPtr == NULL) { - size_t cwdLen; + Tcl_Size cwdLen; Tcl_Obj *copy; copy = AppendPath(fsPathPtr->cwdPtr, pathPtr); @@ -2117,7 +2117,7 @@ Tcl_FSEqualPaths( Tcl_Obj *secondPtr) { const char *firstStr, *secondStr; - size_t firstLen, secondLen; + Tcl_Size firstLen, secondLen; int tempErrno; if (firstPtr == secondPtr) { @@ -2174,7 +2174,7 @@ SetFsPathFromAny( TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ Tcl_Obj *pathPtr) /* The object to convert. */ { - size_t len; + Tcl_Size len; FsPath *fsPathPtr; Tcl_Obj *transPtr; @@ -2207,10 +2207,12 @@ SetFsPathFromAny( fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath)); if (transPtr == pathPtr) { - transPtr = Tcl_DuplicateObj(pathPtr); - fsPathPtr->filesystemEpoch = 0; + (void) Tcl_GetString(pathPtr); + TclFreeInternalRep(pathPtr); + transPtr = Tcl_DuplicateObj(pathPtr); + fsPathPtr->filesystemEpoch = 0; } else { - fsPathPtr->filesystemEpoch = TclFSEpoch(); + fsPathPtr->filesystemEpoch = TclFSEpoch(); } Tcl_IncrRefCount(transPtr); fsPathPtr->translatedPathPtr = transPtr; @@ -2324,7 +2326,7 @@ UpdateStringOfFsPath( Tcl_Obj *pathPtr) /* path obj with string rep to update. */ { FsPath *fsPathPtr = PATHOBJ(pathPtr); - size_t cwdLen; + Tcl_Size cwdLen; Tcl_Obj *copy; if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) { @@ -2396,7 +2398,7 @@ TclNativePathInFilesystem( * situation. */ - size_t len; + Tcl_Size len; (void) Tcl_GetStringFromObj(pathPtr, &len); if (len == 0) { @@ -2542,8 +2544,8 @@ TclResolveTildePath( Tcl_Obj *pathObj) { const char *path; - size_t len; - size_t split; + Tcl_Size len; + Tcl_Size split; Tcl_DString resolvedPath; path = Tcl_GetStringFromObj(pathObj, &len); @@ -2619,8 +2621,8 @@ TclResolveTildePathList( Tcl_Obj *pathsObj) { Tcl_Obj **objv; - size_t objc; - size_t i; + Tcl_Size objc; + Tcl_Size i; Tcl_Obj *resolvedPaths; const char *path; diff --git a/generic/tclPipe.c b/generic/tclPipe.c index b18b789b473e..2eff765b2a53 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -179,12 +179,12 @@ FileForRedirect( void Tcl_DetachPids( - size_t numPids, /* Number of pids to detach: gives size of + Tcl_Size numPids, /* Number of pids to detach: gives size of * array pointed to by pidPtr. */ Tcl_Pid *pidPtr) /* Array of pids to detach. */ { Detached *detPtr; - size_t i; + Tcl_Size i; Tcl_MutexLock(&pipeMutex); for (i = 0; i < numPids; i++) { @@ -269,7 +269,7 @@ Tcl_ReapDetachedProcs(void) int TclCleanupChildren( Tcl_Interp *interp, /* Used for error messages. */ - size_t numPids, /* Number of entries in pidPtr array. */ + Tcl_Size numPids, /* Number of entries in pidPtr array. */ Tcl_Pid *pidPtr, /* Array of process ids of children. */ Tcl_Channel errorChan) /* Channel for file containing stderr output * from pipeline. NULL means there isn't any @@ -278,7 +278,7 @@ TclCleanupChildren( int result = TCL_OK; int code, abnormalExit, anyErrorInfo; TclProcessWaitStatus waitStatus; - size_t i; + Tcl_Size i; Tcl_Obj *msg, *error; abnormalExit = 0; @@ -361,7 +361,7 @@ TclCleanupChildren( if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "child process exited abnormally", TCL_INDEX_NONE)); + "child process exited abnormally", -1)); } return result; } @@ -395,10 +395,10 @@ TclCleanupChildren( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclCreatePipeline( Tcl_Interp *interp, /* Interpreter to use for error reporting. */ - size_t argc, /* Number of entries in argv. */ + Tcl_Size argc, /* Number of entries in argv. */ const char **argv, /* Array of strings describing commands in * pipeline plus I/O redirection with <, <<, * >, etc. Argv[argc] must be NULL. */ @@ -415,7 +415,7 @@ TclCreatePipeline( TclFile *outPipePtr, /* If non-NULL, output to the pipeline goes to * a pipe, unless overridden by redirection in * the command. The file id with which to read - * frome this pipe is stored at *outPipePtr. + * from this pipe is stored at *outPipePtr. * NULL means command specified its own output * sink. */ TclFile *errFilePtr) /* If non-NULL, all stderr output from the @@ -431,9 +431,9 @@ TclCreatePipeline( { Tcl_Pid *pidPtr = NULL; /* Points to malloc-ed array holding all the * pids of child processes. */ - size_t numPids; /* Actual number of processes that exist at + Tcl_Size numPids; /* Actual number of processes that exist at * *pidPtr right now. */ - size_t cmdCount; /* Count of number of distinct commands found + Tcl_Size cmdCount; /* Count of number of distinct commands found * in argc/argv. */ const char *inputLiteral = NULL; /* If non-null, then this points to a string @@ -461,7 +461,7 @@ TclCreatePipeline( const char *p; const char *nextArg; int skip, atOK, flags, needCmd, errorToOutput = 0; - size_t i, j, lastArg, lastBar; + Tcl_Size i, j, lastArg, lastBar; Tcl_DString execBuffer; TclFile pipeIn; TclFile curInFile, curOutFile, curErrFile; @@ -490,14 +490,14 @@ TclCreatePipeline( * and remove them from the argument list in the pipeline. Count the * number of distinct processes (it's the number of "|" arguments plus * one) but don't remove the "|" arguments because they'll be used in the - * second pass to seperate the individual child processes. Cannot start + * second pass to separate the individual child processes. Cannot start * the child processes in this pass because the redirection symbols may * appear anywhere in the command line - e.g., the '<' that specifies the * input to the entire pipe may appear at the very end of the argument * list. */ - lastBar = TCL_INDEX_NONE; + lastBar = -1; cmdCount = 1; needCmd = 1; for (i = 0; i < argc; i++) { @@ -512,7 +512,7 @@ TclCreatePipeline( if (*p == '\0') { if ((i == (lastBar + 1)) || (i == (argc - 1))) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal use of | or |& in command", TCL_INDEX_NONE)); + "illegal use of | or |& in command", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; @@ -700,7 +700,7 @@ TclCreatePipeline( */ Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal use of | or |& in command", TCL_INDEX_NONE)); + "illegal use of | or |& in command", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX", NULL); goto error; @@ -1021,14 +1021,14 @@ Tcl_Channel Tcl_OpenCommandChannel( Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be * NULL. */ - size_t argc, /* How many arguments. */ + Tcl_Size argc, /* How many arguments. */ const char **argv, /* Array of arguments for command pipe. */ int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT, * TCL_STDERR, and TCL_ENFORCE_MODE. */ { TclFile *inPipePtr, *outPipePtr, *errFilePtr; TclFile inPipe, outPipe, errFile; - size_t numPids; + Tcl_Size numPids; Tcl_Pid *pidPtr = NULL; Tcl_Channel channel; @@ -1041,7 +1041,7 @@ Tcl_OpenCommandChannel( numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr, outPipePtr, errFilePtr); - if (numPids == TCL_INDEX_NONE) { + if (numPids < 0) { goto error; } @@ -1054,7 +1054,7 @@ Tcl_OpenCommandChannel( if ((flags & TCL_STDOUT) && (outPipe == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't read output from command:" - " standard output was redirected", TCL_INDEX_NONE)); + " standard output was redirected", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADREDIRECT", NULL); goto error; @@ -1062,7 +1062,7 @@ Tcl_OpenCommandChannel( if ((flags & TCL_STDIN) && (inPipe == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can't write input to command:" - " standard input was redirected", TCL_INDEX_NONE)); + " standard input was redirected", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "BADREDIRECT", NULL); goto error; @@ -1074,7 +1074,7 @@ Tcl_OpenCommandChannel( if (channel == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "pipe for command could not be created", TCL_INDEX_NONE)); + "pipe for command could not be created", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL); goto error; } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 989f133a90d1..3ff7755a7c6a 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -165,7 +165,7 @@ Tcl_PkgProvideEx( pkgPtr = FindPackage(interp, name); if (pkgPtr->version == NULL) { - pkgPtr->version = Tcl_NewStringObj(version, TCL_INDEX_NONE); + pkgPtr->version = Tcl_NewStringObj(version, -1); Tcl_IncrRefCount(pkgPtr->version); pkgPtr->clientData = clientData; return TCL_OK; @@ -291,7 +291,7 @@ TclPkgFileSeen( } else { list = (Tcl_Obj *)Tcl_GetHashValue(entry); } - Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, TCL_INDEX_NONE)); + Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1)); } } @@ -407,7 +407,7 @@ Tcl_PkgRequireEx( != CheckVersionAndConvert(interp, version, NULL, NULL)) { return NULL; } - ov = Tcl_NewStringObj(version, TCL_INDEX_NONE); + ov = Tcl_NewStringObj(version, -1); if (exact) { Tcl_AppendStringsToObj(ov, "-", version, NULL); } @@ -426,7 +426,7 @@ Tcl_PkgRequireProc( Tcl_Interp *interp, /* Interpreter in which package is now * available. */ const char *name, /* Name of desired package. */ - size_t reqc, /* Requirements constraining the desired + Tcl_Size reqc, /* Requirements constraining the desired * version. */ Tcl_Obj *const reqv[], /* 0 means to use the latest version * available. */ @@ -531,7 +531,7 @@ PkgRequireCoreStep1( */ Tcl_DStringInit(&command); - Tcl_DStringAppend(&command, script, TCL_INDEX_NONE); + Tcl_DStringAppend(&command, script, -1); Tcl_DStringAppendElement(&command, name); AddRequirementsToDString(&command, reqc, reqv); @@ -839,7 +839,7 @@ SelectPackage( Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]); - Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, TCL_INDEX_NONE), + Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL); } return TCL_OK; @@ -1080,7 +1080,7 @@ TclNRPackageObjCmd( } optionIndex; Interp *iPtr = (Interp *) interp; int exact, satisfies; - size_t i, newobjc; + Tcl_Size i, newobjc; PkgAvail *availPtr, *prevPtr; Package *pkgPtr; Tcl_HashEntry *hPtr; @@ -1124,7 +1124,7 @@ TclNRPackageObjCmd( PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL); - for (i = 2; i < (size_t)objc; i++) { + for (i = 2; i < objc; i++) { keyString = TclGetString(objv[i]); if (pkgFiles) { hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString); @@ -1160,7 +1160,7 @@ TclNRPackageObjCmd( break; } case PKG_IFNEEDED: { - size_t length; + Tcl_Size length; int res; char *argv3i, *avi; @@ -1200,7 +1200,7 @@ TclNRPackageObjCmd( if (objc == 4) { Tcl_Free(argv3i); Tcl_SetObjResult(interp, - Tcl_NewStringObj(availPtr->script, TCL_INDEX_NONE)); + Tcl_NewStringObj(availPtr->script, -1)); return TCL_OK; } Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC); @@ -1251,7 +1251,7 @@ TclNRPackageObjCmd( pkgPtr = (Package *)Tcl_GetHashValue(hPtr); if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) { Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj( - (char *)Tcl_GetHashKey(tablePtr, hPtr), TCL_INDEX_NONE)); + (char *)Tcl_GetHashKey(tablePtr, hPtr), -1)); } } Tcl_SetObjResult(interp, resultObj); @@ -1353,7 +1353,7 @@ TclNRPackageObjCmd( * Create a new-style requirement for the exact version. */ - ov = Tcl_NewStringObj(version, TCL_INDEX_NONE); + ov = Tcl_NewStringObj(version, -1); Tcl_AppendStringsToObj(ov, "-", version, NULL); version = NULL; argv3 = TclGetString(objv[3]); @@ -1399,12 +1399,12 @@ TclNRPackageObjCmd( } break; case PKG_UNKNOWN: { - size_t length; + Tcl_Size length; if (objc == 2) { if (iPtr->packageUnknown != NULL) { Tcl_SetObjResult(interp, - Tcl_NewStringObj(iPtr->packageUnknown, TCL_INDEX_NONE)); + Tcl_NewStringObj(iPtr->packageUnknown, -1)); } } else if (objc == 3) { if (iPtr->packageUnknown != NULL) { @@ -1456,7 +1456,7 @@ TclNRPackageObjCmd( */ Tcl_SetObjResult(interp, - Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], TCL_INDEX_NONE)); + Tcl_NewStringObj(pkgPreferOptions[iPtr->packagePrefer], -1)); break; } case PKG_VCOMPARE: @@ -1503,7 +1503,7 @@ TclNRPackageObjCmd( for (availPtr = pkgPtr->availPtr; availPtr != NULL; availPtr = availPtr->nextPtr) { Tcl_ListObjAppendElement(NULL, resultObj, - Tcl_NewStringObj(availPtr->version, TCL_INDEX_NONE)); + Tcl_NewStringObj(availPtr->version, -1)); } } Tcl_SetObjResult(interp, resultObj); @@ -1785,7 +1785,7 @@ CompareVersions( * of version numbers). */ int *isMajorPtr) /* If non-null, the word pointed to is filled * in with a 0/1 value. 1 means that the - * difference occured in the first element. */ + * difference occurred in the first element. */ { int thisIsMajor, res, flip; char *s1, *e1, *s2, *e2, o1, o2; @@ -2072,7 +2072,7 @@ AddRequirementsToResult( { Tcl_Obj *result = Tcl_GetObjResult(interp); int i; - size_t length; + Tcl_Size length; for (i = 0; i < reqc; i++) { const char *v = Tcl_GetStringFromObj(reqv[i], &length); @@ -2239,7 +2239,7 @@ RequirementSatisfied( /* * We have both min and max, and generate their internal reps. When - * identical we compare as is, otherwise we pad with 'a0' to ove the range + * identical we compare as is, otherwise we pad with 'a0' to over the range * a bit. */ diff --git a/generic/tclPosixStr.c b/generic/tclPosixStr.c index ecdf6522125c..52d5f099f22c 100644 --- a/generic/tclPosixStr.c +++ b/generic/tclPosixStr.c @@ -62,6 +62,9 @@ Tcl_ErrnoId(void) #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY)) case EALREADY: return "EALREADY"; #endif +#ifdef EBADCAT + case EBADCAT: return "EBADCAT"; +#endif #ifdef EBADE case EBADE: return "EBADE"; #endif @@ -74,9 +77,6 @@ Tcl_ErrnoId(void) #ifdef EBADMSG case EBADMSG: return "EBADMSG"; #endif -#ifdef ECANCELED - case ECANCELED: return "ECANCELED"; -#endif #ifdef EBADR case EBADR: return "EBADR"; #endif @@ -95,6 +95,12 @@ Tcl_ErrnoId(void) #ifdef EBUSY case EBUSY: return "EBUSY"; #endif +#ifdef ECANCELED + case ECANCELED: return "ECANCELED"; +#endif +#ifdef ECASECLASH + case ECASECLASH: return "ECASECLASH"; +#endif #ifdef ECHILD case ECHILD: return "ECHILD"; #endif @@ -140,12 +146,18 @@ Tcl_ErrnoId(void) #ifdef EEXIST case EEXIST: return "EEXIST"; #endif +#ifdef EFAIL + case EFAIL: return "EFAIL"; +#endif #ifdef EFAULT case EFAULT: return "EFAULT"; #endif #ifdef EFBIG case EFBIG: return "EFBIG"; #endif +#ifdef EFTYPE + case EFTYPE: return "EFTYPE"; +#endif #ifdef EHOSTDOWN case EHOSTDOWN: return "EHOSTDOWN"; #endif @@ -161,6 +173,9 @@ Tcl_ErrnoId(void) #ifdef EILSEQ case EILSEQ: return "EILSEQ"; #endif +#ifdef EINPROG + case EINPROG: return "EINPROG"; +#endif #ifdef EINPROGRESS case EINPROGRESS: return "EINPROGRESS"; #endif @@ -179,12 +194,9 @@ Tcl_ErrnoId(void) #ifdef EISDIR case EISDIR: return "EISDIR"; #endif -#ifdef EISNAME +#ifdef EISNAM case EISNAM: return "EISNAM"; #endif -#ifdef ELBIN - case ELBIN: return "ELBIN"; -#endif #ifdef EL2HLT case EL2HLT: return "EL2HLT"; #endif @@ -197,6 +209,9 @@ Tcl_ErrnoId(void) #ifdef EL3RST case EL3RST: return "EL3RST"; #endif +#ifdef ELBIN + case ELBIN: return "ELBIN"; +#endif #ifdef ELIBACC case ELIBACC: return "ELIBACC"; #endif @@ -218,6 +233,9 @@ Tcl_ErrnoId(void) #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) case ELOOP: return "ELOOP"; #endif +#ifdef EMEDIUMTYPE + case EMEDIUMTYPE: return "EMEDIUMTYPE"; +#endif #ifdef EMFILE case EMFILE: return "EMFILE"; #endif @@ -236,9 +254,6 @@ Tcl_ErrnoId(void) #ifdef ENAVAIL case ENAVAIL: return "ENAVAIL"; #endif -#ifdef ENET - case ENET: return "ENET"; -#endif #ifdef ENETDOWN case ENETDOWN: return "ENETDOWN"; #endif @@ -251,6 +266,9 @@ Tcl_ErrnoId(void) #ifdef ENFILE case ENFILE: return "ENFILE"; #endif +#ifdef ENMFILE + case ENMFILE: return "ENMFILE"; +#endif #ifdef ENOANO case ENOANO: return "ENOANO"; #endif @@ -281,6 +299,9 @@ Tcl_ErrnoId(void) #ifdef ENOMEM case ENOMEM: return "ENOMEM"; #endif +#ifdef ENOMEDIUM + case ENOMEDIUM: return "ENOMEDIUM"; +#endif #ifdef ENOMSG case ENOMSG: return "ENOMSG"; #endif @@ -293,6 +314,9 @@ Tcl_ErrnoId(void) #ifdef ENOPROTOOPT case ENOPROTOOPT: return "ENOPROTOOPT"; #endif +#ifdef ENOSHARE + case ENOSHARE: return "ENOSHARE"; +#endif #ifdef ENOSPC case ENOSPC: return "ENOSPC"; #endif @@ -338,6 +362,9 @@ Tcl_ErrnoId(void) #ifdef ENOTUNIQ case ENOTUNIQ: return "ENOTUNIQ"; #endif +#ifdef ENWAIT + case ENWAIT: return "ENWAIT"; +#endif #ifdef ENXIO case ENXIO: return "ENXIO"; #endif @@ -404,6 +431,9 @@ Tcl_ErrnoId(void) #ifdef EREMOTERELEASE case EREMOTERELEASE: return "EREMOTERELEASE"; #endif +#ifdef ERESTART + case ERESTART: return "ERESTART"; +#endif #ifdef EROFS case EROFS: return "EROFS"; #endif @@ -519,34 +549,34 @@ Tcl_ErrnoMsg( case EAGAIN: return "resource temporarily unavailable"; #endif #ifdef EALIGN - case EALIGN: return "EALIGN"; + case EALIGN: return "alignment error"; #endif #if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY)) case EALREADY: return "operation already in progress"; #endif +#ifdef EBADCAT + case EBADCAT: return "bad message catalogue format"; +#endif #ifdef EBADE - case EBADE: return "bad exchange descriptor"; + case EBADE: return "invalid exchange"; #endif #ifdef EBADF - case EBADF: return "bad file number"; + case EBADF: return "bad file descriptor"; #endif #ifdef EBADFD case EBADFD: return "file descriptor in bad state"; #endif #ifdef EBADMSG - case EBADMSG: return "not a data message"; -#endif -#ifdef ECANCELED - case ECANCELED: return "operation canceled"; + case EBADMSG: return "bad message"; #endif #ifdef EBADR - case EBADR: return "bad request descriptor"; + case EBADR: return "invalid request descriptor"; #endif #ifdef EBADRPC case EBADRPC: return "RPC structure is bad"; #endif #ifdef EBADRQC - case EBADRQC: return "bad request code"; + case EBADRQC: return "invalid request code"; #endif #ifdef EBADSLT case EBADSLT: return "invalid slot"; @@ -555,10 +585,16 @@ Tcl_ErrnoMsg( case EBFONT: return "bad font file format"; #endif #ifdef EBUSY - case EBUSY: return "file busy"; + case EBUSY: return "device or resource busy"; +#endif +#ifdef ECANCELED + case ECANCELED: return "operation canceled"; +#endif +#ifdef ECASECLASH + case ECASECLASH: return "filename exists with different case"; #endif #ifdef ECHILD - case ECHILD: return "no children"; + case ECHILD: return "no child processes"; #endif #ifdef ECHRNG case ECHRNG: return "channel number out of range"; @@ -588,7 +624,7 @@ Tcl_ErrnoMsg( case EDIRTY: return "mounting a dirty fs w/o force"; #endif #ifdef EDOM - case EDOM: return "math argument out of range"; + case EDOM: return "numerical argument out of domain"; #endif #ifdef EDOTDOT case EDOTDOT: return "cross mount point"; @@ -600,19 +636,25 @@ Tcl_ErrnoMsg( case EDUPPKG: return "duplicate package name"; #endif #ifdef EEXIST - case EEXIST: return "file already exists"; + case EEXIST: return "file exists"; +#endif +#ifdef EFAIL + case EFAIL: return "cannot start operation"; #endif #ifdef EFAULT - case EFAULT: return "bad address in system call argument"; + case EFAULT: return "bad address"; #endif #ifdef EFBIG case EFBIG: return "file too large"; #endif +#ifdef EFTYPE + case EFTYPE: return "inappropriate file type or format"; +#endif #ifdef EHOSTDOWN case EHOSTDOWN: return "host is down"; #endif #ifdef EHOSTUNREACH - case EHOSTUNREACH: return "host is unreachable"; + case EHOSTUNREACH: return "no route to host"; #endif #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) case EIDRM: return "identifier removed"; @@ -621,7 +663,10 @@ Tcl_ErrnoMsg( case EINIT: return "initialization error"; #endif #ifdef EILSEQ - case EILSEQ: return "illegal byte sequence"; + case EILSEQ: return "invalid or incomplete multibyte or wide character"; +#endif +#ifdef EINPROG + case EINPROG: return "asynchronous operation in progress"; #endif #ifdef EINPROGRESS case EINPROGRESS: return "operation now in progress"; @@ -633,19 +678,16 @@ Tcl_ErrnoMsg( case EINVAL: return "invalid argument"; #endif #ifdef EIO - case EIO: return "I/O error"; + case EIO: return "input/output error"; #endif #ifdef EISCONN - case EISCONN: return "socket is already connected"; + case EISCONN: return "transport endpoint is already connected"; #endif #ifdef EISDIR - case EISDIR: return "illegal operation on a directory"; + case EISDIR: return "is a directory"; #endif -#ifdef EISNAME - case EISNAM: return "is a name file"; -#endif -#ifdef ELBIN - case ELBIN: return "ELBIN"; +#ifdef EISNAM + case EISNAM: return "is a named type file"; #endif #ifdef EL2HLT case EL2HLT: return "level 2 halted"; @@ -659,8 +701,11 @@ Tcl_ErrnoMsg( #ifdef EL3RST case EL3RST: return "level 3 reset"; #endif +#ifdef ELBIN + case ELBIN: return "inode is remote"; +#endif #ifdef ELIBACC - case ELIBACC: return "cannot access a needed shared library"; + case ELIBACC: return "can not access a needed shared library"; #endif #ifdef ELIBBAD case ELIBBAD: return "accessing a corrupted shared library"; @@ -670,7 +715,7 @@ Tcl_ErrnoMsg( #endif #if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED)) case ELIBMAX: return - "attempting to link in more shared libraries than system limit"; + "attempting to link in too many shared libraries"; #endif #ifdef ELIBSCN case ELIBSCN: return ".lib section in a.out corrupted"; @@ -681,6 +726,9 @@ Tcl_ErrnoMsg( #if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) case ELOOP: return "too many levels of symbolic links"; #endif +#ifdef EMEDIUMTYPE + case EMEDIUMTYPE: return "wrong medium type"; +#endif #ifdef EMFILE case EMFILE: return "too many open files"; #endif @@ -699,9 +747,6 @@ Tcl_ErrnoMsg( #ifdef ENAVAIL case ENAVAIL: return "not available"; #endif -#ifdef ENET - case ENET: return "ENET"; -#endif #ifdef ENETDOWN case ENETDOWN: return "network is down"; #endif @@ -712,10 +757,13 @@ Tcl_ErrnoMsg( case ENETUNREACH: return "network is unreachable"; #endif #ifdef ENFILE - case ENFILE: return "file table overflow"; + case ENFILE: return "too many open files in system"; +#endif +#ifdef ENMFILE + case ENMFILE: return "no more files"; #endif #ifdef ENOANO - case ENOANO: return "anode table overflow"; + case ENOANO: return "no anode"; #endif #if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) case ENOBUFS: return "no buffer space available"; @@ -742,7 +790,10 @@ Tcl_ErrnoMsg( case ENOLINK: return "link has been severed"; #endif #ifdef ENOMEM - case ENOMEM: return "not enough memory"; + case ENOMEM: return "cannot allocate memory"; +#endif +#ifdef ENOMEDIUM + case ENOMEDIUM: return "no medium found"; #endif #ifdef ENOMSG case ENOMSG: return "no message of desired type"; @@ -754,16 +805,19 @@ Tcl_ErrnoMsg( case ENOPKG: return "package not installed"; #endif #ifdef ENOPROTOOPT - case ENOPROTOOPT: return "bad protocol option"; + case ENOPROTOOPT: return "protocol not available"; +#endif +#ifdef ENOSHARE + case ENOSHARE: return "no such host or network path"; #endif #ifdef ENOSPC case ENOSPC: return "no space left on device"; #endif #if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) - case ENOSR: return "out of stream resources"; + case ENOSR: return "out of streams resources"; #endif #if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) - case ENOSTR: return "not a stream device"; + case ENOSTR: return "device not a stream"; #endif #ifdef ENOSYM case ENOSYM: return "unresolved symbol name"; @@ -775,10 +829,7 @@ Tcl_ErrnoMsg( case ENOTBLK: return "block device required"; #endif #ifdef ENOTCONN - case ENOTCONN: return "socket is not connected"; -#endif -#ifdef ENOTRECOVERABLE - case ENOTRECOVERABLE: return "state not recoverable"; + case ENOTCONN: return "transport endpoint is not connected"; #endif #ifdef ENOTDIR case ENOTDIR: return "not a directory"; @@ -789,6 +840,9 @@ Tcl_ErrnoMsg( #ifdef ENOTNAM case ENOTNAM: return "not a name file"; #endif +#ifdef ENOTRECOVERABLE + case ENOTRECOVERABLE: return "state not recoverable"; +#endif #ifdef ENOTSOCK case ENOTSOCK: return "socket operation on non-socket"; #endif @@ -796,11 +850,14 @@ Tcl_ErrnoMsg( case ENOTSUP: return "operation not supported"; #endif #ifdef ENOTTY - case ENOTTY: return "inappropriate device for ioctl"; + case ENOTTY: return "inappropriate ioctl for device"; #endif #ifdef ENOTUNIQ case ENOTUNIQ: return "name not unique on network"; #endif +#ifdef ENWAIT + case ENWAIT: return "No waiting processes"; +#endif #ifdef ENXIO case ENXIO: return "no such device or address"; #endif @@ -811,13 +868,13 @@ Tcl_ErrnoMsg( case EOTHER: return "other error"; #endif #if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL)) - case EOVERFLOW: return "file too big"; + case EOVERFLOW: return "value too large for defined data type"; #endif #ifdef EOWNERDEAD case EOWNERDEAD: return "owner died"; #endif #ifdef EPERM - case EPERM: return "not owner"; + case EPERM: return "operation not permitted"; #endif #if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) case EPFNOSUPPORT: return "protocol family not supported"; @@ -847,10 +904,10 @@ Tcl_ErrnoMsg( case EPROTOTYPE: return "protocol wrong type for socket"; #endif #ifdef ERANGE - case ERANGE: return "math result unrepresentable"; + case ERANGE: return "numerical result out of range"; #endif #if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) - case EREFUSED: return "EREFUSED"; + case EREFUSED: return "connection refused"; #endif #ifdef EREMCHG case EREMCHG: return "remote address changed"; @@ -859,13 +916,16 @@ Tcl_ErrnoMsg( case EREMDEV: return "remote device"; #endif #ifdef EREMOTE - case EREMOTE: return "pathname hit remote file system"; + case EREMOTE: return "object is remote"; #endif #ifdef EREMOTEIO - case EREMOTEIO: return "remote i/o error"; + case EREMOTEIO: return "remote I/O error"; #endif #ifdef EREMOTERELEASE - case EREMOTERELEASE: return "EREMOTERELEASE"; + case EREMOTERELEASE: return "remote peer released connection"; +#endif +#ifdef ERESTART + case ERESTART: return "interrupted system call should be restarted"; #endif #ifdef EROFS case EROFS: return "read-only file system"; @@ -877,13 +937,13 @@ Tcl_ErrnoMsg( case ERREMOTE: return "object is remote"; #endif #ifdef ESHUTDOWN - case ESHUTDOWN: return "cannot send after socket shutdown"; + case ESHUTDOWN: return "cannot send after transport endpoint shutdown"; #endif #ifdef ESOCKTNOSUPPORT case ESOCKTNOSUPPORT: return "socket type not supported"; #endif #ifdef ESPIPE - case ESPIPE: return "invalid seek"; + case ESPIPE: return "illegal seek"; #endif #ifdef ESRCH case ESRCH: return "no such process"; @@ -892,10 +952,13 @@ Tcl_ErrnoMsg( case ESRMNT: return "srmount error"; #endif #ifdef ESTALE - case ESTALE: return "stale remote file handle"; + case ESTALE: return "stale file handle"; +#endif +#ifdef ESTRPIPE + case ESTRPIPE: return "streams pipe error"; #endif #ifdef ESUCCESS - case ESUCCESS: return "Error 0"; + case ESUCCESS: return "success"; #endif #if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) case ETIME: return "timer expired"; @@ -907,7 +970,7 @@ Tcl_ErrnoMsg( case ETOOMANYREFS: return "too many references: cannot splice"; #endif #ifdef ETXTBSY - case ETXTBSY: return "text file or pseudo-device busy"; + case ETXTBSY: return "text file busy"; #endif #ifdef EUCLEAN case EUCLEAN: return "structure needs cleaning"; @@ -925,10 +988,10 @@ Tcl_ErrnoMsg( case EWOULDBLOCK: return "operation would block"; #endif #ifdef EXDEV - case EXDEV: return "cross-domain link"; + case EXDEV: return "invalid cross-device link"; #endif #ifdef EXFULL - case EXFULL: return "message tables full"; + case EXFULL: return "exchange full"; #endif default: #ifdef NO_STRERROR diff --git a/generic/tclProc.c b/generic/tclProc.c index a472a2d15df7..d12394ceb5ef 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -524,9 +524,9 @@ TclCreateProc( } if (fieldCount > 2) { Tcl_Obj *errorObj = Tcl_NewStringObj( - "too many fields in argument specifier \"", TCL_INDEX_NONE); + "too many fields in argument specifier \"", -1); Tcl_AppendObjToObj(errorObj, argArray[i]); - Tcl_AppendToObj(errorObj, "\"", TCL_INDEX_NONE); + Tcl_AppendToObj(errorObj, "\"", -1); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); @@ -534,7 +534,7 @@ TclCreateProc( } if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "argument with no name", TCL_INDEX_NONE)); + "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; @@ -560,9 +560,9 @@ TclCreateProc( } } else if (*argnamei == ':' && *(argnamei+1) == ':') { Tcl_Obj *errorObj = Tcl_NewStringObj( - "formal parameter \"", TCL_INDEX_NONE); + "formal parameter \"", -1); Tcl_AppendObjToObj(errorObj, fieldValues[0]); - Tcl_AppendToObj(errorObj, "\" is not a simple name", TCL_INDEX_NONE); + Tcl_AppendToObj(errorObj, "\" is not a simple name", -1); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); @@ -613,7 +613,7 @@ TclCreateProc( "procedure \"%s\": formal parameter \"", procName); Tcl_AppendObjToObj(errorObj, fieldValues[0]); Tcl_AppendToObj(errorObj, "\" has " - "default value inconsistent with precompiled body", TCL_INDEX_NONE); + "default value inconsistent with precompiled body", -1); Tcl_SetObjResult(interp, errorObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "BYTECODELIES", NULL); @@ -1080,7 +1080,7 @@ ProcWrongNumArgs( sizeof(Tcl_Obj *) * (numArgs+1)); if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { - desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", TCL_INDEX_NONE); + desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { desiredObjs[0] = framePtr->objv[skip-1]; } @@ -1507,7 +1507,7 @@ TclPushProcCallFrame( * interpreted. */ Tcl_Interp *interp,/* Interpreter in which procedure was * invoked. */ - Tcl_Size objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[], /* Argument value objects. */ int isLambda) /* 1 if this is a call by ApplyObjCmd: it @@ -1634,11 +1634,11 @@ TclNRInterpProc( static int NRInterpProc2( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - size_t objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1653,11 +1653,11 @@ NRInterpProc2( static int ObjInterpProc2( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - size_t objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1941,7 +1941,7 @@ TclProcCompileProc( if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { if ((Interp *) *codePtr->interpHandle != iPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "a precompiled script jumped interps", TCL_INDEX_NONE)); + "a precompiled script jumped interps", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "CROSSINTERPBYTECODE", NULL); return TCL_ERROR; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 0dad7c4e0f28..b621e31c7ac3 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -233,9 +233,9 @@ WaitProcessStatus( if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( "error waiting for process to exit: %s", msg); if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("POSIX", TCL_INDEX_NONE); - errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), TCL_INDEX_NONE); - errorStrings[2] = Tcl_NewStringObj(msg, TCL_INDEX_NONE); + errorStrings[0] = Tcl_NewStringObj("POSIX", -1); + errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); + errorStrings[2] = Tcl_NewStringObj(msg, -1); *errorObjPtr = Tcl_NewListObj(3, errorStrings); } return TCL_PROCESS_ERROR; @@ -256,9 +256,9 @@ WaitProcessStatus( */ if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( - "child process exited abnormally", TCL_INDEX_NONE); + "child process exited abnormally", -1); if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", TCL_INDEX_NONE); + errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1); TclNewIntObj(errorStrings[1], resolvedPid); TclNewIntObj(errorStrings[2], WEXITSTATUS(waitStatus)); *errorObjPtr = Tcl_NewListObj(3, errorStrings); @@ -277,10 +277,10 @@ WaitProcessStatus( if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( "child killed: %s", msg); if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", TCL_INDEX_NONE); + errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1); TclNewIntObj(errorStrings[1], resolvedPid); - errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), TCL_INDEX_NONE); - errorStrings[3] = Tcl_NewStringObj(msg, TCL_INDEX_NONE); + errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1); + errorStrings[3] = Tcl_NewStringObj(msg, -1); *errorObjPtr = Tcl_NewListObj(4, errorStrings); } return TCL_PROCESS_SIGNALED; @@ -296,10 +296,10 @@ WaitProcessStatus( if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf( "child suspended: %s", msg); if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", TCL_INDEX_NONE); + errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1); TclNewIntObj(errorStrings[1], resolvedPid); - errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), TCL_INDEX_NONE); - errorStrings[3] = Tcl_NewStringObj(msg, TCL_INDEX_NONE); + errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1); + errorStrings[3] = Tcl_NewStringObj(msg, -1); *errorObjPtr = Tcl_NewListObj(4, errorStrings); } return TCL_PROCESS_STOPPED; @@ -312,12 +312,12 @@ WaitProcessStatus( if (codePtr) *codePtr = waitStatus; if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj( - "child wait status didn't make sense\n", TCL_INDEX_NONE); + "child wait status didn't make sense\n", -1); if (errorObjPtr) { - errorStrings[0] = Tcl_NewStringObj("TCL", TCL_INDEX_NONE); - errorStrings[1] = Tcl_NewStringObj("OPERATION", TCL_INDEX_NONE); - errorStrings[2] = Tcl_NewStringObj("EXEC", TCL_INDEX_NONE); - errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", TCL_INDEX_NONE); + errorStrings[0] = Tcl_NewStringObj("TCL", -1); + errorStrings[1] = Tcl_NewStringObj("OPERATION", -1); + errorStrings[2] = Tcl_NewStringObj("EXEC", -1); + errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1); TclNewIntObj(errorStrings[4], resolvedPid); *errorObjPtr = Tcl_NewListObj(5, errorStrings); } @@ -455,7 +455,7 @@ ProcessStatusObjCmd( Tcl_HashEntry *entry; Tcl_HashSearch search; ProcessInfo *info; - size_t i, numPids; + Tcl_Size i, numPids; Tcl_Obj **pidObjs; int result; int pid; @@ -600,7 +600,7 @@ ProcessPurgeObjCmd( Tcl_HashEntry *entry; Tcl_HashSearch search; ProcessInfo *info; - size_t i, numPids; + Tcl_Size i, numPids; Tcl_Obj **pidObjs; int result, pid; diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 07beffd6ac91..dfdf12db855a 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -253,7 +253,7 @@ void Tcl_RegExpRange( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - size_t index, /* 0 means give the range of the entire match, + Tcl_Size index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching * subrange. */ const char **startPtr, /* Store address of first character in @@ -264,9 +264,9 @@ Tcl_RegExpRange( TclRegexp *regexpPtr = (TclRegexp *) re; const char *string; - if (index > regexpPtr->re.re_nsub) { + if (index < 0 || (size_t) index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; - } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) { + } else if (regexpPtr->matches[index].rm_so == (size_t) -1) { *startPtr = *endPtr = NULL; } else { if (regexpPtr->objPtr) { @@ -363,23 +363,23 @@ void TclRegExpRangeUniChar( Tcl_RegExp re, /* Compiled regular expression that has been * passed to Tcl_RegExpExec. */ - size_t index, /* 0 means give the range of the entire match, + Tcl_Size index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching - * subrange, TCL_INDEX_NONE means the range of the + * subrange, -1 means the range of the * rm_extend field. */ - size_t *startPtr, /* Store address of first character in + Tcl_Size *startPtr, /* Store address of first character in * (sub-)range here. */ - size_t *endPtr) /* Store address of character just after last + Tcl_Size *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; - if ((regexpPtr->flags®_EXPECT) && (index == TCL_INDEX_NONE)) { + if ((regexpPtr->flags®_EXPECT) && (index == -1)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; - } else if (index + 1 > regexpPtr->re.re_nsub + 1) { - *startPtr = TCL_INDEX_NONE; - *endPtr = TCL_INDEX_NONE; + } else if (index < 0 || (size_t) index > regexpPtr->re.re_nsub + 1) { + *startPtr = -1; + *endPtr = -1; } else { *startPtr = regexpPtr->matches[index].rm_so; *endPtr = regexpPtr->matches[index].rm_eo; @@ -443,16 +443,16 @@ Tcl_RegExpExecObj( * returned by previous call to * Tcl_GetRegExpFromObj. */ Tcl_Obj *textObj, /* Text against which to match re. */ - size_t offset, /* Character index that marks where matching + Tcl_Size offset, /* Character index that marks where matching * should begin. */ - size_t nmatches, /* How many subexpression matches (counting + Tcl_Size nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ { TclRegexp *regexpPtr = (TclRegexp *) re; Tcl_UniChar *udata; - size_t length; + Tcl_Size length; int reflags = regexpPtr->flags; #define TCL_REG_GLOBOK_FLAGS \ (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE) @@ -595,7 +595,7 @@ Tcl_GetRegExpFromObj( * expression. */ int flags) /* Regular expression compilation flags. */ { - size_t length; + Tcl_Size length; TclRegexp *regexpPtr; const char *pattern; @@ -689,7 +689,7 @@ TclRegAbout( for (inf=infonames ; inf->bit != 0 ; inf++) { if (regexpPtr->re.re_info & inf->bit) { Tcl_ListObjAppendElement(NULL, infoObj, - Tcl_NewStringObj(inf->text, TCL_INDEX_NONE)); + Tcl_NewStringObj(inf->text, -1)); } } Tcl_ListObjAppendElement(NULL, resultObj, infoObj); @@ -730,7 +730,7 @@ TclRegError( p = (n > sizeof(buf)) ? "..." : ""; Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p)); - sprintf(cbuf, "%d", status); + snprintf(cbuf, sizeof(cbuf), "%d", status); (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf)); Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL); } diff --git a/generic/tclResult.c b/generic/tclResult.c index 6a36fdfcfc2f..c06a73ae67eb 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -10,6 +10,7 @@ */ #include "tclInt.h" +#include /* * Indices of the standard return options dictionary keys. @@ -211,40 +212,36 @@ Tcl_DiscardInterpState( *---------------------------------------------------------------------- * * Tcl_SetObjResult -- - * - * Arrange for objPtr to be an interpreter's result value. + * Makes objPtr the interpreter's result value. * * Results: * None. * * Side effects: - * interp->objResultPtr is left pointing to the object referenced by - * objPtr. The object's reference count is incremented since there is now - * a new reference to it. The reference count for any old objResultPtr - * value is decremented. Also, the string result is reset. + * Stores objPtr interp->objResultPtr, increments its reference count, and + * decrements the reference count of any existing interp->objResultPtr. + * + * The string result is reset. * *---------------------------------------------------------------------- */ void Tcl_SetObjResult( - Tcl_Interp *interp, /* Interpreter with which to associate the - * return object value. */ - Tcl_Obj *objPtr) /* Tcl object to be returned. If NULL, the obj - * result is made an empty string object. */ + Tcl_Interp *interp, /* Interpreter to set the result for. */ + Tcl_Obj *objPtr) /* The value to set as the result. */ { Interp *iPtr = (Interp *) interp; Tcl_Obj *oldObjResult = iPtr->objResultPtr; - - iPtr->objResultPtr = objPtr; - Tcl_IncrRefCount(objPtr); /* since interp result is a reference */ - - /* - * We wait until the end to release the old object result, in case we are - * setting the result to itself. - */ - - TclDecrRefCount(oldObjResult); + if (objPtr == oldObjResult) { + /* This should be impossible */ + assert(objPtr->refCount != 0); + return; + } else { + iPtr->objResultPtr = objPtr; + Tcl_IncrRefCount(objPtr); + TclDecrRefCount(oldObjResult); + } } /* @@ -317,7 +314,7 @@ Tcl_AppendResult( if (bytes == NULL) { break; } - Tcl_AppendToObj(objPtr, bytes, TCL_INDEX_NONE); + Tcl_AppendToObj(objPtr, bytes, -1); } Tcl_SetObjResult(interp, objPtr); va_end(argList); @@ -354,10 +351,10 @@ Tcl_AppendElement( * to result. */ { Interp *iPtr = (Interp *) interp; - Tcl_Obj *elementPtr = Tcl_NewStringObj(element, TCL_INDEX_NONE); + Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1); Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr); const char *bytes; - size_t length; + Tcl_Size length; if (Tcl_IsShared(iPtr->objResultPtr)) { Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr)); @@ -511,7 +508,7 @@ Tcl_SetErrorCode( if (elem == NULL) { break; } - Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, TCL_INDEX_NONE)); + Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1)); } Tcl_SetObjErrorCode(interp, errorObj); va_end(argList); @@ -721,7 +718,7 @@ TclProcessReturn( Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr); if (valuePtr != NULL) { - size_t length; + Tcl_Size length; (void) Tcl_GetStringFromObj(valuePtr, &length); if (length) { @@ -733,7 +730,7 @@ TclProcessReturn( Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK], &valuePtr); if (valuePtr != NULL) { - size_t len, valueObjc; + Tcl_Size len, valueObjc; Tcl_Obj **valueObjv; if (Tcl_IsShared(iPtr->errorStack)) { @@ -910,7 +907,7 @@ TclMergeReturnOptions( Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr); if (valuePtr != NULL) { - size_t length; + Tcl_Size length; if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) { /* @@ -932,7 +929,7 @@ TclMergeReturnOptions( Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr); if (valuePtr != NULL) { - size_t length; + Tcl_Size length; if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length)) { /* @@ -1100,7 +1097,7 @@ Tcl_SetReturnOptions( Tcl_Interp *interp, Tcl_Obj *options) { - size_t objc; + Tcl_Size objc; int level, code; Tcl_Obj **objv, *mergedOpts; diff --git a/generic/tclScan.c b/generic/tclScan.c index 6a5bfb755d80..b7bd94ad4bd7 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -11,6 +11,7 @@ #include "tclInt.h" #include "tclTomMath.h" +#include /* * Flag values used by Tcl_ScanObjCmd. @@ -258,7 +259,7 @@ ValidateFormat( int *totalSubs) /* The number of variables that will be * required. */ { - int gotXpg, gotSequential, value, i, flags; + int gotXpg, gotSequential, i, flags; char *end; Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; @@ -306,7 +307,8 @@ ValidateFormat( * format string. */ - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ + /* assert(value is >= 0) because of the isdigit() check above */ + unsigned long long ull = strtoull(format-1, &end, 10); /* INTL: "C" locale. */ if (*end != '$') { goto notXpg; } @@ -316,17 +318,22 @@ ValidateFormat( if (gotSequential) { goto mixedXPG; } - objIndex = value - 1; - if ((objIndex < 0) || (numVars && (objIndex >= numVars))) { + /* >=INT_MAX because 9.0 does not support more than INT_MAX-1 args */ + if (ull == 0 || ull >= INT_MAX) { goto badIndex; - } else if (numVars == 0) { + } + objIndex = (int) ull - 1; + if (numVars && (objIndex >= numVars)) { + goto badIndex; + } + else if (numVars == 0) { /* * In the case where no vars are specified, the user can * specify %9999$ legally, so we have to consider special - * rules for growing the assign array. 'value' is guaranteed - * to be > 0. + * rules for growing the assign array. 'ull' is guaranteed + * to be > 0 and < INT_MAX as per checks above. */ - xpgSize = (xpgSize > value) ? xpgSize : value; + xpgSize = (xpgSize > (int)ull) ? xpgSize : (int)ull; } goto xpgCheckDone; } @@ -348,7 +355,22 @@ ValidateFormat( */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - value = strtoul(format-1, (char **) &format, 10); /* INTL: "C" locale. */ + /* Note ull >= 0 because of isdigit check above */ + unsigned long long ull; + ull = strtoull( + format - 1, (char **)&format, 10); /* INTL: "C" locale. */ + /* Note >=, not >, to leave room for a nul */ + if (ull >= TCL_SIZE_MAX) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER + "u exceeds limit %" TCL_SIZE_MODIFIER "d.", + ull, + (Tcl_Size)TCL_SIZE_MAX-1)); + Tcl_SetErrorCode( + interp, "TCL", "FORMAT", "WIDTHLIMIT", NULL); + goto error; + } flags |= SCAN_WIDTH; format += TclUtfToUniChar(format, &ch); } @@ -397,9 +419,9 @@ ValidateFormat( invalidFieldSize: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; errorMsg = Tcl_NewStringObj( - "field size modifier may not be specified in %", TCL_INDEX_NONE); - Tcl_AppendToObj(errorMsg, buf, TCL_INDEX_NONE); - Tcl_AppendToObj(errorMsg, " conversion", TCL_INDEX_NONE); + "field size modifier may not be specified in %", -1); + Tcl_AppendToObj(errorMsg, buf, -1); + Tcl_AppendToObj(errorMsg, " conversion", -1); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL); goto error; @@ -452,15 +474,15 @@ ValidateFormat( break; badSet: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unmatched [ in format string", TCL_INDEX_NONE)); + "unmatched [ in format string", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL); goto error; default: buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; errorMsg = Tcl_NewStringObj( - "bad scan conversion character \"", TCL_INDEX_NONE); - Tcl_AppendToObj(errorMsg, buf, TCL_INDEX_NONE); - Tcl_AppendToObj(errorMsg, "\"", TCL_INDEX_NONE); + "bad scan conversion character \"", -1); + Tcl_AppendToObj(errorMsg, buf, -1); + Tcl_AppendToObj(errorMsg, "\"", -1); Tcl_SetObjResult(interp, errorMsg); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL); goto error; @@ -473,7 +495,7 @@ ValidateFormat( * guaranteed to be at least one larger than objIndex. */ - value = nspace; + int nspaceOrig = nspace; if (xpgSize) { nspace = xpgSize; } else { @@ -481,7 +503,7 @@ ValidateFormat( } nassign = (int *)TclStackRealloc(interp, nassign, nspace * sizeof(int)); - for (i = value; i < nspace; i++) { + for (i = nspaceOrig; i < nspace; i++) { nassign[i] = 0; } } @@ -531,7 +553,7 @@ ValidateFormat( badIndex: if (gotXpg) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"%n$\" argument index out of range", TCL_INDEX_NONE)); + "\"%n$\" argument index out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -575,7 +597,8 @@ Tcl_ScanObjCmd( long value; const char *string, *end, *baseString; char op = 0; - int width, underflow = 0; + int underflow = 0; + Tcl_Size width; Tcl_WideInt wideValue; Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; @@ -670,6 +693,7 @@ Tcl_ScanObjCmd( format += TclUtfToUniChar(format, &ch); } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ char *formatEnd; + /* Note currently XPG3 range limited to INT_MAX to match type of objc */ value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */ if (*formatEnd == '$') { format = formatEnd+1; @@ -683,7 +707,10 @@ Tcl_ScanObjCmd( */ if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ - width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */ + unsigned long long ull; + ull = strtoull(format-1, (char **) &format, 10); /* INTL: "C" locale. */ + assert(ull <= TCL_SIZE_MAX); /* Else ValidateFormat should've error'ed */ + width = (Tcl_Size)ull; format += TclUtfToUniChar(format, &ch); } else { width = 0; @@ -926,7 +953,7 @@ Tcl_ScanObjCmd( mp_int big; if (mp_init_u64(&big, (Tcl_WideUInt)wideValue) != MP_OKAY) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create bignum", TCL_INDEX_NONE)); + "insufficient memory to create bignum", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else { @@ -953,7 +980,7 @@ Tcl_ScanObjCmd( } Tcl_DecrRefCount(objPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unsigned bignum scans are invalid", TCL_INDEX_NONE)); + "unsigned bignum scans are invalid", -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL); return TCL_ERROR; @@ -972,7 +999,7 @@ Tcl_ScanObjCmd( mp_int big; if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "insufficient memory to create bignum", TCL_INDEX_NONE)); + "insufficient memory to create bignum", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } else { @@ -1067,12 +1094,15 @@ Tcl_ScanObjCmd( } else { /* * Here no vars were specified, we want a list returned (inline scan) + * We create an empty Tcl_Obj to fill missing values rather than + * allocating a new Tcl_Obj every time. See test scan-bigdata-XX. */ - + Tcl_Obj *emptyObj = Tcl_NewObj(); + Tcl_IncrRefCount(emptyObj); TclNewObj(objPtr); - for (i = 0; i < totalVars; i++) { + for (i = 0; code == TCL_OK && i < totalVars; i++) { if (objs[i] != NULL) { - Tcl_ListObjAppendElement(NULL, objPtr, objs[i]); + code = Tcl_ListObjAppendElement(interp, objPtr, objs[i]); Tcl_DecrRefCount(objs[i]); } else { /* @@ -1080,8 +1110,19 @@ Tcl_ScanObjCmd( * empty strings for these. */ - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj()); + code = Tcl_ListObjAppendElement(interp, objPtr, emptyObj); + } + } + Tcl_DecrRefCount(emptyObj); + if (code != TCL_OK) { + /* If error'ed out, free up remaining. i contains last index freed */ + while (++i < totalVars) { + if (objs[i] != NULL) { + Tcl_DecrRefCount(objs[i]); + } } + Tcl_DecrRefCount(objPtr); + objPtr = NULL; } } if (objs != NULL) { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 2f29617c95af..5a173af8527a 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -484,7 +484,7 @@ TclParseNumber( * ("integer", "boolean value", etc.). */ const char *bytes, /* Pointer to the start of the string to * scan. */ - size_t numBytes, /* Maximum number of bytes to scan, see + Tcl_Size numBytes, /* Maximum number of bytes to scan, see * above. */ const char **endPtrPtr, /* Place to store pointer to the character * that terminated the scan. */ @@ -529,10 +529,10 @@ TclParseNumber( * number. */ long exponent = 0; /* Exponent of a floating point number. */ const char *p; /* Pointer to next character to scan. */ - size_t len; /* Number of characters remaining after p. */ + Tcl_Size len; /* Number of characters remaining after p. */ const char *acceptPoint; /* Pointer to position after last character in * an acceptable number. */ - size_t acceptLen; /* Number of characters following that + Tcl_Size acceptLen; /* Number of characters following that * point. */ int status = TCL_OK; /* Status to return to caller. */ char d = 0; /* Last hexadecimal digit scanned; initialized @@ -556,7 +556,7 @@ TclParseNumber( return TCL_ERROR; } if (TclHasInternalRep(objPtr, &tclListType.objType)) { - size_t length; + Tcl_Size length; /* A list can only be a (single) number if its length == 1 */ TclListObjLengthM(NULL, objPtr, &length); if (length != 1) { @@ -1523,7 +1523,7 @@ TclParseNumber( expected); Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, ""); - Tcl_AppendToObj(msg, "\"", TCL_INDEX_NONE); + Tcl_AppendToObj(msg, "\"", -1); Tcl_SetObjResult(interp, msg); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); } @@ -1751,7 +1751,7 @@ MakeLowPrecisionDouble( } /* - * All the easy cases have failed. Promote ths significand to bignum and + * All the easy cases have failed. Promote the significand to bignum and * call MakeHighPrecisionDouble to do it the hard way. */ @@ -2053,7 +2053,7 @@ RefineApproximation( /* * Compute twoMd as 2*M*d, where d is the exact value. * This is done by multiplying by 5**(M5+exponent) and then multiplying - * by 2**(M5+exponent+1), which is, of couse, a left shift. + * by 2**(M5+exponent+1), which is, of course, a left shift. */ if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) { @@ -2282,7 +2282,7 @@ NormalizeRightward( * * RequiredPrecision -- * - * Determines the number of bits needed to hold an intger. + * Determines the number of bits needed to hold an integer. * * Results: * Returns the position of the most significant bit (0 - 63). Returns 0 @@ -4787,7 +4787,7 @@ Tcl_InitBignumFromDouble( if (interp != NULL) { const char *s = "integer value too large to represent"; - Tcl_SetObjResult(interp, Tcl_NewStringObj(s, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1)); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL); } return TCL_ERROR; @@ -5273,7 +5273,7 @@ TclFormatNaN( *buffer++ = 'N'; bitwhack.iv &= ((UINT64_C(1)) << 51) - 1; if (bitwhack.iv != 0) { - sprintf(buffer, "(%" PRIx64 ")", bitwhack.iv); + snprintf(buffer, TCL_DOUBLE_SPACE, "(%" PRIx64 ")", bitwhack.iv); } else { *buffer = '\0'; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index edfe1413e6ff..d2bc1b27fa2c 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1,29 +1,27 @@ /* * tclStringObj.c -- * - * This file contains functions that implement string operations on Tcl - * objects. Some string operations work with UTF strings and others - * require Unicode format. Functions that require knowledge of the width - * of each character, such as indexing, operate on Unicode data. - * - * A Unicode string is an internationalized string. Conceptually, a - * Unicode string is an array of 16-bit quantities organized as a - * sequence of properly formed UTF-8 characters. There is a one-to-one - * map between Unicode and UTF characters. Because Unicode characters - * have a fixed width, operations such as indexing operate on Unicode - * data. The String object is optimized for the case where each UTF char + * This file contains functions that implement string operations on Tcl + * objects. Some string operations work with UTF-8 encoding forms. + * Functions that require knowledge of the width of each character, + * such as indexing, operate on fixed width encoding forms such as UTF-32. + * + * Conceptually, a string is a sequence of Unicode code points. Internally + * it may be stored in an encoding form such as a modified version of + * UTF-8 or UTF-16 (when TCL_UTF_MAX=3) or UTF-32. + * + * The String object is optimized for the case where each UTF char * in a string is only one byte. In this case, we store the value of - * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode - * is explicitly called). + * numChars, but we don't store the fixed form encoding (unless + * Tcl_GetUnicode is explicitly called). * - * The String object type stores one or both formats. The default - * behavior is to store UTF. Once Unicode is calculated by a function, it - * is stored in the internal rep for future access (without an additional - * O(n) cost). + * The String object type stores one or both formats. The default + * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is + * stored in the internal rep for future access (without an additional + * O(n) cost). * * To allow many appends to be done to an object without constantly - * reallocating the space for the string or Unicode representation, we - * allocate double the space for the string or Unicode and use the + * reallocating space, we allocate double the space and use the * internal representation to keep track of how much space is used vs. * allocated. * @@ -45,28 +43,28 @@ static void AppendPrintfToObjVA(Tcl_Obj *objPtr, const char *format, va_list argList); static void AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t appendNumChars); + const Tcl_UniChar *unicode, Tcl_Size appendNumChars); static void AppendUnicodeToUtfRep(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); + const Tcl_UniChar *unicode, Tcl_Size numChars); static void AppendUtfToUnicodeRep(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes); + const char *bytes, Tcl_Size numBytes); static void AppendUtfToUtfRep(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes); + const char *bytes, Tcl_Size numBytes); static void DupStringInternalRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr); -static size_t ExtendStringRepWithUnicode(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); +static Tcl_Size ExtendStringRepWithUnicode(Tcl_Obj *objPtr, + const Tcl_UniChar *unicode, Tcl_Size numChars); static void ExtendUnicodeRepWithString(Tcl_Obj *objPtr, - const char *bytes, size_t numBytes, - size_t numAppendChars); + const char *bytes, Tcl_Size numBytes, + Tcl_Size numAppendChars); static void FillUnicodeRep(Tcl_Obj *objPtr); static void FreeStringInternalRep(Tcl_Obj *objPtr); static void GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag); static void GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed); static int SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void SetUnicodeObj(Tcl_Obj *objPtr, - const Tcl_UniChar *unicode, size_t numChars); -static size_t UnicodeLength(const Tcl_UniChar *unicode); + const Tcl_UniChar *unicode, Tcl_Size numChars); +static Tcl_Size UnicodeLength(const Tcl_UniChar *unicode); static void UpdateStringOfString(Tcl_Obj *objPtr); #if TCL_UTF_MAX > 3 @@ -137,7 +135,7 @@ GrowStringBuffer( int flag) { /* - * Pre-conditions: + * Preconditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->allocated * flag || objPtr->bytes != NULL @@ -185,7 +183,7 @@ GrowUnicodeBuffer( size_t needed) { /* - * Pre-conditions: + * Preconditions: * objPtr->typePtr == &tclStringType * needed > stringPtr->maxChars */ @@ -257,7 +255,7 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length) /* The number of bytes to copy from "bytes" + Tcl_Size length) /* The number of bytes to copy from "bytes" * when initializing the new object. If * TCL_INDEX_NONE, use bytes up to the first NUL * byte. */ @@ -269,13 +267,13 @@ Tcl_Obj * Tcl_NewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length) /* The number of bytes to copy from "bytes" + Tcl_Size length) /* The number of bytes to copy from "bytes" * when initializing the new object. If -1, * use bytes up to the first NUL byte. */ { Tcl_Obj *objPtr; - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = (bytes? strlen(bytes) : 0); } TclNewStringObj(objPtr, bytes, length); @@ -317,7 +315,7 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length, /* The number of bytes to copy from "bytes" + Tcl_Size length, /* The number of bytes to copy from "bytes" * when initializing the new object. If -1, * use bytes up to the first NUL byte. */ const char *file, /* The name of the source file calling this @@ -339,7 +337,7 @@ Tcl_Obj * Tcl_DbNewStringObj( const char *bytes, /* Points to the first of the length bytes * used to initialize the new object. */ - size_t length, /* The number of bytes to copy from "bytes" + Tcl_Size length, /* The number of bytes to copy from "bytes" * when initializing the new object. If -1, * use bytes up to the first NUL byte. */ TCL_UNUSED(const char *) /*file*/, @@ -372,7 +370,7 @@ Tcl_Obj * Tcl_NewUnicodeObj( const Tcl_UniChar *unicode, /* The unicode string used to initialize the * new object. */ - size_t numChars) /* Number of characters in the unicode + Tcl_Size numChars) /* Number of characters in the unicode * string. */ { Tcl_Obj *objPtr; @@ -390,7 +388,7 @@ Tcl_NewUnicodeObj( * Get the length of the Unicode string from the Tcl object. * * Results: - * Pointer to unicode string representing the unicode object. + * Pointer to Unicode string representing the Unicode object. * * Side effects: * Frees old internal rep. Allocates memory for new "String" internal @@ -399,13 +397,13 @@ Tcl_NewUnicodeObj( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_GetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { String *stringPtr; - size_t numChars = 0; + Tcl_Size numChars = 0; /* * Quick, no-shimmer return for short string reps. @@ -444,19 +442,19 @@ Tcl_GetCharLength( * If numChars is unknown, compute it. */ - if (numChars == TCL_INDEX_NONE) { + if (numChars < 0) { TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length); stringPtr->numChars = numChars; } return numChars; } -size_t +Tcl_Size TclGetCharLength( Tcl_Obj *objPtr) /* The String object to get the num chars * of. */ { - size_t numChars = 0; + Tcl_Size numChars = 0; /* * Quick, no-shimmer return for short string reps. @@ -509,12 +507,17 @@ int TclCheckEmptyString( Tcl_Obj *objPtr) { - size_t length = TCL_INDEX_NONE; + Tcl_Size length = TCL_INDEX_NONE; if (objPtr->bytes == &tclEmptyString) { return TCL_EMPTYSTRING_YES; } + if (TclIsPureByteArray(objPtr) + && Tcl_GetCharLength(objPtr) == 0) { + return TCL_EMPTYSTRING_YES; + } + if (TclListObjIsCanonical(objPtr)) { TclListObjLengthM(NULL, objPtr, &length); return length == 0; @@ -553,18 +556,22 @@ int Tcl_GetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - size_t index) /* Get the index'th Unicode character. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { String *stringPtr; int ch; + if (index < 0) { + return -1; + } + /* - * Optimize the case where we're really dealing with a bytearray object + * Optimize the case where we're really dealing with a ByteArray object * we don't need to convert to a string to perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { - size_t length = 0; + Tcl_Size length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; @@ -622,17 +629,21 @@ int TclGetUniChar( Tcl_Obj *objPtr, /* The object to get the Unicode charater * from. */ - size_t index) /* Get the index'th Unicode character. */ + Tcl_Size index) /* Get the index'th Unicode character. */ { int ch = 0; + if (index < 0) { + return -1; + } + /* - * Optimize the case where we're really dealing with a bytearray object - * we don't need to convert to a string to perform the indexing operation. + * Optimize the ByteArray case: N need need to convert to a string to + * perform the indexing operation. */ if (TclIsPureByteArray(objPtr)) { - size_t length = 0; + Tcl_Size length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); if (index >= length) { return -1; @@ -641,7 +652,7 @@ TclGetUniChar( return bytes[index]; } - size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); + Tcl_Size numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); if (index >= numChars) { return -1; @@ -672,12 +683,13 @@ TclGetUniChar( */ #undef Tcl_GetUnicodeFromObj +#if !defined(TCL_NO_DEPRECATED) Tcl_UniChar * TclGetUnicodeFromObj( - Tcl_Obj *objPtr, /* The object to find the unicode string + Tcl_Obj *objPtr, /* The object to find the Unicode string * for. */ - int *lengthPtr) /* If non-NULL, the location where the string - * rep's unichar length should be stored. If + void *lengthPtr) /* If non-NULL, the location where the string + * rep's Tcl_UniChar length should be stored. If * NULL, no length is stored. */ { String *stringPtr; @@ -693,18 +705,19 @@ TclGetUnicodeFromObj( if (lengthPtr != NULL) { if (stringPtr->numChars > INT_MAX) { Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr" - "cannot handle such long strings. Please use 'size_t'"); + " cannot handle such long strings. Please use 'Tcl_Size'"); } - *lengthPtr = (int)stringPtr->numChars; + *(int *)lengthPtr = (int)stringPtr->numChars; } return stringPtr->unicode; } +#endif /* !defined(TCL_NO_DEPRECATED) */ Tcl_UniChar * Tcl_GetUnicodeFromObj( Tcl_Obj *objPtr, /* The object to find the unicode string * for. */ - size_t *lengthPtr) /* If non-NULL, the location where the string + Tcl_Size *lengthPtr) /* If non-NULL, the location where the string * rep's unichar length should be stored. If * NULL, no length is stored. */ { @@ -747,14 +760,14 @@ Tcl_GetUnicodeFromObj( Tcl_Obj * Tcl_GetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - size_t first, /* First index of the range. */ - size_t last) /* Last index of the range. */ + Tcl_Size first, /* First index of the range. */ + Tcl_Size last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ String *stringPtr; - size_t length = 0; + Tcl_Size length = 0; - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = TCL_INDEX_START; } @@ -766,10 +779,10 @@ Tcl_GetRange( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); - if (last >= length) { + if (last < 0 || last >= length) { last = length - 1; } - if (last + 1 < first + 1) { + if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } @@ -792,10 +805,10 @@ Tcl_GetRange( TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { - if (last >= stringPtr->numChars) { + if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } - if (last + 1 < first + 1) { + if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } @@ -813,20 +826,20 @@ Tcl_GetRange( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - if (last >= stringPtr->numChars) { + if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } - if (last + 1 < first + 1) { + if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } #if TCL_UTF_MAX < 4 /* See: bug [11ae2be95dac9417] */ - if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) + if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } - if ((last + 2 < stringPtr->numChars + 1) + if ((last + 1 < stringPtr->numChars) && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; @@ -838,13 +851,13 @@ Tcl_GetRange( Tcl_Obj * TclGetRange( Tcl_Obj *objPtr, /* The Tcl object to find the range of. */ - size_t first, /* First index of the range. */ - size_t last) /* Last index of the range. */ + Tcl_Size first, /* First index of the range. */ + Tcl_Size last) /* Last index of the range. */ { Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */ - size_t length = 0; + Tcl_Size length = 0; - if (first == TCL_INDEX_NONE) { + if (first < 0) { first = TCL_INDEX_START; } @@ -856,22 +869,22 @@ TclGetRange( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); - if (last >= length) { + if (last < 0 || last >= length) { last = length - 1; } - if (last + 1 < first + 1) { + if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } return Tcl_NewByteArrayObj(bytes + first, last - first + 1); } - size_t numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); + Tcl_Size numChars = TclNumUtfChars(objPtr->bytes, objPtr->length); - if (last >= numChars) { + if (last < 0 || last >= numChars) { last = numChars - 1; } - if (last + 1 < first + 1) { + if (last < first) { TclNewObj(newObjPtr); return newObjPtr; } @@ -906,7 +919,7 @@ Tcl_SetStringObj( Tcl_Obj *objPtr, /* Object whose internal rep to init. */ const char *bytes, /* Points to the first of the length bytes * used to initialize the object. */ - size_t length) /* The number of bytes to copy from "bytes" + Tcl_Size length) /* The number of bytes to copy from "bytes" * when initializing the object. If -1, * use bytes up to the first NUL byte.*/ { @@ -937,20 +950,19 @@ Tcl_SetStringObj( * * Tcl_SetObjLength -- * - * This function changes the length of the string representation of an - * object. + * Changes the length of the string representation of objPtr. * * Results: * None. * * Side effects: - * If the size of objPtr's string representation is greater than length, - * then it is reduced to length and a new terminating null byte is stored - * in the strength. If the length of the string representation is greater - * than length, the storage space is reallocated to the given length; a - * null byte is stored at the end, but other bytes past the end of the - * original string representation are undefined. The object's internal - * representation is changed to "expendable string". + * If the size of objPtr's string representation is greater than length, a + * new terminating null byte is stored in objPtr->bytes at length, and + * bytes at positions past length have no meaning. If the length of the + * string representation is greater than length, the storage space is + * reallocated to length+1. + * + * The object's internal representation is changed to &tclStringType. * *---------------------------------------------------------------------- */ @@ -959,12 +971,16 @@ void Tcl_SetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - size_t length) /* Number of bytes desired for string + Tcl_Size length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; + if (length < 0) { + Tcl_Panic("Tcl_SetObjLength: length requested is negative: " + "%" TCL_SIZE_MODIFIER "d (integer overflow?)", length); + } if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetObjLength"); } @@ -996,7 +1012,7 @@ Tcl_SetObjLength( objPtr->bytes[length] = 0; /* - * Invalidate the unicode data. + * Invalidate the Unicode data. */ stringPtr->numChars = TCL_INDEX_NONE; @@ -1009,7 +1025,7 @@ Tcl_SetObjLength( } /* - * Mark the new end of the unicode string + * Mark the new end of the Unicode string */ stringPtr->numChars = length; @@ -1050,12 +1066,17 @@ int Tcl_AttemptSetObjLength( Tcl_Obj *objPtr, /* Pointer to object. This object must not * currently be shared. */ - size_t length) /* Number of bytes desired for string + Tcl_Size length) /* Number of bytes desired for string * representation of object, not including * terminating null byte. */ { String *stringPtr; + if (length < 0) { + /* Negative lengths => most likely integer overflow */ + return 0; + } + if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength"); } @@ -1093,14 +1114,14 @@ Tcl_AttemptSetObjLength( objPtr->bytes[length] = 0; /* - * Invalidate the unicode data. + * Invalidate the Unicode data. */ stringPtr->numChars = TCL_INDEX_NONE; stringPtr->hasUnicode = 0; } else { /* - * Changing length of pure unicode string. + * Changing length of pure Unicode string. */ if (length > stringPtr->maxChars) { @@ -1113,7 +1134,7 @@ Tcl_AttemptSetObjLength( } /* - * Mark the new end of the unicode string. + * Mark the new end of the Unicode string. */ stringPtr->unicode[length] = 0; @@ -1147,9 +1168,9 @@ Tcl_AttemptSetObjLength( void Tcl_SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ - const Tcl_UniChar *unicode, /* The unicode string used to initialize the + const Tcl_UniChar *unicode, /* The Unicode string used to initialize the * object. */ - size_t numChars) /* Number of characters in the unicode + Tcl_Size numChars) /* Number of characters in the Unicode * string. */ { if (Tcl_IsShared(objPtr)) { @@ -1159,14 +1180,15 @@ Tcl_SetUnicodeObj( SetUnicodeObj(objPtr, unicode, numChars); } -static size_t +static Tcl_Size UnicodeLength( const Tcl_UniChar *unicode) { - size_t numChars = 0; + Tcl_Size numChars = 0; if (unicode) { - while ((numChars != TCL_INDEX_NONE) && (unicode[numChars] != 0)) { + /* TODO - is this overflow check really necessary? */ + while ((numChars >= 0) && (unicode[numChars] != 0)) { numChars++; } } @@ -1176,14 +1198,14 @@ UnicodeLength( static void SetUnicodeObj( Tcl_Obj *objPtr, /* The object to set the string of. */ - const Tcl_UniChar *unicode, /* The unicode string used to initialize the + const Tcl_UniChar *unicode, /* The Unicode string used to initialize the * object. */ - size_t numChars) /* Number of characters in the unicode + Tcl_Size numChars) /* Number of characters in the Unicode * string. */ { String *stringPtr; - if (numChars == TCL_INDEX_NONE) { + if (numChars < 0) { numChars = UnicodeLength(unicode); } @@ -1228,20 +1250,20 @@ Tcl_AppendLimitedToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - size_t length, /* The number of bytes available to be + Tcl_Size length, /* The number of bytes available to be * appended from "bytes". If -1, then * all bytes up to a NUL byte are available. */ - size_t limit, /* The maximum number of bytes to append to + Tcl_Size limit, /* The maximum number of bytes to append to * the object. */ const char *ellipsis) /* Ellipsis marker string, appended to the * object to indicate not all available bytes * at "bytes" were appended. */ { String *stringPtr; - size_t toCopy = 0; - size_t eLen = 0; + Tcl_Size toCopy = 0; + Tcl_Size eLen = 0; - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = (bytes ? strlen(bytes) : 0); } if (length == 0) { @@ -1324,11 +1346,11 @@ Tcl_AppendToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* Points to the bytes to append to the * object. */ - size_t length) /* The number of bytes to append from "bytes". + Tcl_Size length) /* The number of bytes to append from "bytes". * If TCL_INDEX_NONE, then append all bytes up to NUL * byte. */ { - Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL); + Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_SIZE_MAX, NULL); } /* @@ -1337,7 +1359,7 @@ Tcl_AppendToObj( * Tcl_AppendUnicodeToObj -- * * This function appends a Unicode string to an object in the most - * efficient manner possible. Length must be >= 0. + * efficient manner possible. * * Results: * None. @@ -1351,9 +1373,10 @@ Tcl_AppendToObj( void Tcl_AppendUnicodeToObj( Tcl_Obj *objPtr, /* Points to the object to append to. */ - const Tcl_UniChar *unicode, /* The unicode string to append to the + const Tcl_UniChar *unicode, /* The Unicode string to append to the * object. */ - size_t length) /* Number of chars in "unicode". */ + Tcl_Size length) /* Number of chars in Unicode. Negative + * lengths means nul terminated */ { String *stringPtr; @@ -1407,30 +1430,30 @@ Tcl_AppendObjToObj( Tcl_Obj *appendObjPtr) /* Object to append. */ { String *stringPtr; - size_t length = 0, numChars; - size_t appendNumChars = TCL_INDEX_NONE; + Tcl_Size length = 0, numChars; + Tcl_Size appendNumChars = TCL_INDEX_NONE; const char *bytes; - /* - * Special case: second object is standard-empty is fast case. We know - * that appending nothing to anything leaves that starting anything... - */ + if (TclCheckEmptyString(appendObjPtr) == TCL_EMPTYSTRING_YES) { + return; + } - if (appendObjPtr->bytes == &tclEmptyString) { + if (TclCheckEmptyString(objPtr) == TCL_EMPTYSTRING_YES) { + TclSetDuplicateObj(objPtr, appendObjPtr); return; } - /* - * Handle append of one bytearray object to another as a special case. - * Note that we only do this when the objects are pure so that the - * bytearray faithfully represent the true value; Otherwise appending the - * byte arrays together could lose information; - */ + if ( + TclIsPureByteArray(appendObjPtr) + && (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) + ) { + /* + * Both bytearray objects are pure, so the second internal bytearray value + * can be appended to the first, with no need to modify the "bytes" field. + */ - if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString) - && TclIsPureByteArray(appendObjPtr)) { /* - * You might expect the code here to be + * One might expect the code here to be * * bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length); * TclAppendBytesToByteArray(objPtr, bytes, length); @@ -1448,7 +1471,7 @@ Tcl_AppendObjToObj( * First, get the lengths. */ - size_t lengthSrc = 0; + Tcl_Size lengthSrc = 0; (void) Tcl_GetByteArrayFromObj(objPtr, &length); (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); @@ -1471,7 +1494,7 @@ Tcl_AppendObjToObj( */ TclAppendBytesToByteArray(objPtr, - Tcl_GetByteArrayFromObj(appendObjPtr, (size_t *)NULL), lengthSrc); + Tcl_GetByteArrayFromObj(appendObjPtr, (Tcl_Size *) NULL), lengthSrc); return; } @@ -1520,7 +1543,7 @@ Tcl_AppendObjToObj( bytes = Tcl_GetStringFromObj(appendObjPtr, &length); numChars = stringPtr->numChars; - if ((numChars != TCL_INDEX_NONE) && TclHasInternalRep(appendObjPtr, &tclStringType)) { + if ((numChars >= 0) && TclHasInternalRep(appendObjPtr, &tclStringType)) { String *appendStringPtr = GET_STRING(appendObjPtr); appendNumChars = appendStringPtr->numChars; @@ -1528,7 +1551,7 @@ Tcl_AppendObjToObj( AppendUtfToUtfRep(objPtr, bytes, length); - if ((numChars != TCL_INDEX_NONE) && (appendNumChars != TCL_INDEX_NONE)) { + if ((numChars >= 0) && (appendNumChars >= 0)) { stringPtr->numChars = numChars + appendNumChars; } } @@ -1538,8 +1561,8 @@ Tcl_AppendObjToObj( * * AppendUnicodeToUnicodeRep -- * - * This function appends the contents of "unicode" to the Unicode rep of - * "objPtr". objPtr must already have a valid Unicode rep. + * Appends the contents of unicode to the Unicode rep of + * objPtr, which must already have a valid Unicode rep. * * Results: * None. @@ -1554,12 +1577,12 @@ static void AppendUnicodeToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to append. */ - size_t appendNumChars) /* Number of chars of "unicode" to append. */ + Tcl_Size appendNumChars) /* Number of chars of "unicode" to append. */ { String *stringPtr; - size_t numChars; + Tcl_Size numChars; - if (appendNumChars == TCL_INDEX_NONE) { + if (appendNumChars < 0) { appendNumChars = UnicodeLength(unicode); } if (appendNumChars == 0) { @@ -1570,7 +1593,7 @@ AppendUnicodeToUnicodeRep( stringPtr = GET_STRING(objPtr); /* - * If not enough space has been allocated for the unicode rep, reallocate + * If not enough space has been allocated for the Unicode rep, reallocate * the internal rep object with additional space. First try to double the * required allocation; if that fails, try a more modest increase. See the * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an @@ -1580,28 +1603,28 @@ AppendUnicodeToUnicodeRep( numChars = stringPtr->numChars + appendNumChars; if (numChars > stringPtr->maxChars) { - size_t index = TCL_INDEX_NONE; + Tcl_Size offset = -1; /* - * Protect against case where unicode points into the existing + * Protect against case where Unicode points into the existing * stringPtr->unicode array. Force it to follow any relocations due to * the reallocs below. */ if (unicode && unicode >= stringPtr->unicode && unicode <= stringPtr->unicode + stringPtr->maxChars) { - index = unicode - stringPtr->unicode; + offset = unicode - stringPtr->unicode; } GrowUnicodeBuffer(objPtr, numChars); stringPtr = GET_STRING(objPtr); /* - * Relocate unicode if needed; see above. + * Relocate Unicode if needed; see above. */ - if (index != TCL_INDEX_NONE) { - unicode = stringPtr->unicode + index; + if (offset >= 0) { + unicode = stringPtr->unicode + offset; } } @@ -1642,7 +1665,7 @@ static void AppendUnicodeToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const Tcl_UniChar *unicode, /* String to convert to UTF. */ - size_t numChars) /* Number of chars of "unicode" to convert. */ + Tcl_Size numChars) /* Number of chars of Unicode to convert. */ { String *stringPtr = GET_STRING(objPtr); @@ -1675,7 +1698,7 @@ static void AppendUtfToUnicodeRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to convert to Unicode. */ - size_t numBytes) /* Number of bytes of "bytes" to convert. */ + Tcl_Size numBytes) /* Number of bytes of "bytes" to convert. */ { String *stringPtr; @@ -1683,7 +1706,7 @@ AppendUtfToUnicodeRep( return; } - ExtendUnicodeRepWithString(objPtr, bytes, numBytes, TCL_INDEX_NONE); + ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1); TclInvalidateStringRep(objPtr); stringPtr = GET_STRING(objPtr); stringPtr->allocated = 0; @@ -1711,10 +1734,10 @@ static void AppendUtfToUtfRep( Tcl_Obj *objPtr, /* Points to the object to append to. */ const char *bytes, /* String to append. */ - size_t numBytes) /* Number of bytes of "bytes" to append. */ + Tcl_Size numBytes) /* Number of bytes of "bytes" to append. */ { String *stringPtr; - size_t newLength, oldLength; + Tcl_Size newLength, oldLength; if (numBytes == 0) { return; @@ -1729,11 +1752,14 @@ AppendUtfToUtfRep( objPtr->length = 0; } oldLength = objPtr->length; + if (numBytes > TCL_SIZE_MAX - oldLength) { + Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX); + } newLength = numBytes + oldLength; stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { - size_t offset = TCL_INDEX_NONE; + Tcl_Size offset = -1; /* * Protect against case where unicode points into the existing @@ -1757,7 +1783,7 @@ AppendUtfToUtfRep( * Relocate bytes if needed; see above. */ - if (offset != TCL_INDEX_NONE) { + if (offset >= 0) { bytes = objPtr->bytes + offset; } } @@ -1766,7 +1792,7 @@ AppendUtfToUtfRep( * Invalidate the unicode data. */ - stringPtr->numChars = TCL_INDEX_NONE; + stringPtr->numChars = -1; stringPtr->hasUnicode = 0; if (bytes) { @@ -1812,7 +1838,7 @@ Tcl_AppendStringsToObj( if (bytes == NULL) { break; } - Tcl_AppendToObj(objPtr, bytes, TCL_INDEX_NONE); + Tcl_AppendToObj(objPtr, bytes, -1); } va_end(argList); } @@ -1842,12 +1868,12 @@ Tcl_AppendFormatToObj( Tcl_Interp *interp, Tcl_Obj *appendObj, const char *format, - size_t objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { const char *span = format, *msg, *errCode; int gotXpg = 0, gotSequential = 0; - size_t objIndex = 0, originalLength, limit, numBytes = 0; + Tcl_Size objIndex = 0, originalLength, limit, numBytes = 0; Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; @@ -1861,7 +1887,7 @@ Tcl_AppendFormatToObj( Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj"); } (void)Tcl_GetStringFromObj(appendObj, &originalLength); - limit = (size_t)INT_MAX - originalLength; + limit = TCL_SIZE_MAX - originalLength; /* * Format string is NUL-terminated. @@ -1870,12 +1896,13 @@ Tcl_AppendFormatToObj( while (*format != '\0') { char *end; int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0; - int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0; + int gotPrecision, sawFlag, useShort = 0, useBig = 0; + Tcl_Size width, precision; #ifndef TCL_WIDE_INT_IS_LONG int useWide = 0; #endif - int newXpg, numChars, allocSegment = 0, segmentLimit; - size_t segmentNumBytes; + int newXpg, allocSegment = 0; + Tcl_Size numChars, segmentLimit, segmentNumBytes; Tcl_Obj *segment; int step = TclUtfToUniChar(format, &ch); @@ -1939,7 +1966,7 @@ Tcl_AppendFormatToObj( } gotSequential = 1; } - if (objIndex >= objc) { + if (objIndex < 0 || objIndex >= objc) { msg = badIndex[gotXpg]; errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; @@ -1982,12 +2009,16 @@ Tcl_AppendFormatToObj( width = 0; if (isdigit(UCHAR(ch))) { - width = strtoul(format, &end, 10); - if (width < 0) { + /* Note ull will be >= 0 because of isdigit check above */ + unsigned long long ull; + ull = strtoull(format, &end, 10); + /* Comparison is >=, not >, to leave room for nul */ + if (ull >= TCL_SIZE_MAX) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; } + width = (Tcl_Size)ull; format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { @@ -1996,7 +2027,7 @@ Tcl_AppendFormatToObj( errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } - if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { + if (TclGetSizeIntFromObj(interp, objv[objIndex], &width) != TCL_OK) { goto error; } if (width < 0) { @@ -2007,7 +2038,7 @@ Tcl_AppendFormatToObj( format += step; step = TclUtfToUniChar(format, &ch); } - if (width > (int) limit) { + if (width > limit) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; @@ -2024,7 +2055,16 @@ Tcl_AppendFormatToObj( step = TclUtfToUniChar(format, &ch); } if (isdigit(UCHAR(ch))) { - precision = strtoul(format, &end, 10); + /* Note ull will be >= 0 because of isdigit check above */ + unsigned long long ull; + ull = strtoull(format, &end, 10); + /* Comparison is >=, not >, to leave room for nul */ + if (ull >= TCL_SIZE_MAX) { + msg = overflow; + errCode = "OVERFLOW"; + goto errorMsg; + } + precision = (Tcl_Size)ull; format = end; step = TclUtfToUniChar(format, &ch); } else if (ch == '*') { @@ -2033,7 +2073,7 @@ Tcl_AppendFormatToObj( errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH"; goto errorMsg; } - if (TclGetIntFromObj(interp, objv[objIndex], &precision) + if (TclGetSizeIntFromObj(interp, objv[objIndex], &precision) != TCL_OK) { goto error; } @@ -2159,7 +2199,8 @@ Tcl_AppendFormatToObj( long l; Tcl_WideInt w; mp_int big; - int toAppend, isNegative = 0; + int isNegative = 0; + Tcl_Size toAppend; #ifndef TCL_WIDE_INT_IS_LONG if (ch == 'p') { @@ -2217,7 +2258,7 @@ Tcl_AppendFormatToObj( TclNewObj(segment); allocSegment = 1; - segmentLimit = INT_MAX; + segmentLimit = TCL_SIZE_MAX; Tcl_IncrRefCount(segment); if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) { @@ -2247,7 +2288,7 @@ Tcl_AppendFormatToObj( switch (ch) { case 'd': { - size_t length; + Tcl_Size length; Tcl_Obj *pure; const char *bytes; @@ -2282,10 +2323,10 @@ Tcl_AppendFormatToObj( */ if (gotPrecision) { - if (length < (size_t)precision) { + if (length < precision) { segmentLimit -= precision - length; } - while (length < (size_t)precision) { + while (length < precision) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2293,10 +2334,10 @@ Tcl_AppendFormatToObj( } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < (size_t)width) { + if (length < width) { segmentLimit -= width - length; } - while (length < (size_t)width) { + while (length < width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2320,7 +2361,7 @@ Tcl_AppendFormatToObj( Tcl_WideUInt bits = 0; Tcl_WideInt numDigits = 0; int numBits = 4, base = 16, index = 0, shift = 0; - size_t length; + Tcl_Size length; Tcl_Obj *pure; char *bytes; @@ -2414,10 +2455,10 @@ Tcl_AppendFormatToObj( mp_clear(&big); } if (gotPrecision) { - if (length < (size_t)precision) { + if (length < precision) { segmentLimit -= precision - length; } - while (length < (size_t)precision) { + while (length < precision) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2425,10 +2466,10 @@ Tcl_AppendFormatToObj( } if (gotZero) { length += Tcl_GetCharLength(segment); - if (length < (size_t)width) { + if (length < width) { segmentLimit -= width - length; } - while (length < (size_t)width) { + while (length < width) { Tcl_AppendToObj(segment, "0", 1); length++; } @@ -2481,15 +2522,17 @@ Tcl_AppendFormatToObj( *p++ = '+'; } if (width) { - p += sprintf(p, "%d", width); + p += snprintf( + p, TCL_INTEGER_SPACE, "%" TCL_SIZE_MODIFIER "d", width); if (width > length) { length = width; } } if (gotPrecision) { *p++ = '.'; - p += sprintf(p, "%d", precision); - if (precision > INT_MAX - length) { + p += snprintf( + p, TCL_INTEGER_SPACE, "%" TCL_SIZE_MODIFIER "d", precision); + if (precision > TCL_SIZE_MAX - length) { msg = overflow; errCode = "OVERFLOW"; goto errorMsg; @@ -2588,7 +2631,7 @@ Tcl_AppendFormatToObj( errorMsg: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL); } error: @@ -2614,7 +2657,7 @@ Tcl_Obj * Tcl_Format( Tcl_Interp *interp, const char *format, - size_t objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { int result; @@ -2648,7 +2691,7 @@ AppendPrintfToObjVA( va_list argList) { int code; - size_t objc; + Tcl_Size objc; Tcl_Obj **objv, *list; const char *p; @@ -2895,7 +2938,7 @@ Tcl_ObjPrintf( char * TclGetStringStorage( Tcl_Obj *objPtr, - size_t *sizePtr) + Tcl_Size *sizePtr) { String *stringPtr; @@ -2929,14 +2972,16 @@ Tcl_Obj * TclStringRepeat( Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t count, + Tcl_Size count, int flags) { Tcl_Obj *objResultPtr; int inPlace = flags & TCL_STRING_IN_PLACE; - size_t length = 0, unichar = 0, done = 1; + Tcl_Size length = 0; + int unichar = 0; + Tcl_Size done = 1; int binary = TclIsPureByteArray(objPtr); - size_t maxCount; + Tcl_Size maxCount; /* assert (count >= 2) */ @@ -2959,15 +3004,15 @@ TclStringRepeat( if (binary) { /* Result will be pure byte array. Pre-size it */ (void)Tcl_GetByteArrayFromObj(objPtr, &length); - maxCount = TCL_SIZE_SMAX; + maxCount = TCL_SIZE_MAX; } else if (unichar) { /* Result will be pure Tcl_UniChar array. Pre-size it. */ (void)Tcl_GetUnicodeFromObj(objPtr, &length); - maxCount = TCL_SIZE_SMAX/sizeof(Tcl_UniChar); + maxCount = TCL_SIZE_MAX/sizeof(Tcl_UniChar); } else { /* Result will be concat of string reps. Pre-size it. */ (void)Tcl_GetStringFromObj(objPtr, &length); - maxCount = TCL_SIZE_SMAX; + maxCount = TCL_SIZE_MAX; } if (length == 0) { @@ -2980,9 +3025,9 @@ TclStringRepeat( if (interp) { Tcl_SetObjResult( interp, - Tcl_ObjPrintf("max size for a Tcl value (%" TCL_Z_MODIFIER - "u bytes) exceeded", - TCL_SIZE_SMAX)); + Tcl_ObjPrintf("max size for a Tcl value (%" TCL_SIZE_MODIFIER + "d bytes) exceeded", + TCL_SIZE_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -3001,7 +3046,7 @@ TclStringRepeat( done *= 2; } TclAppendBytesToByteArray(objResultPtr, - Tcl_GetByteArrayFromObj(objResultPtr, (size_t *)NULL), + Tcl_GetByteArrayFromObj(objResultPtr, (Tcl_Size *) NULL), (count - done) * length); } else if (unichar) { /* @@ -3015,11 +3060,12 @@ TclStringRepeat( objResultPtr = objPtr; } + /* TODO - overflow check */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "string size overflow: unable to alloc %" - TCL_Z_MODIFIER "u bytes", + TCL_SIZE_MODIFIER "d bytes", STRING_SIZE(count*length))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } @@ -3043,10 +3089,11 @@ TclStringRepeat( TclFreeInternalRep(objPtr); objResultPtr = objPtr; } + /* TODO - overflow check */ if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes", + "string size overflow: unable to alloc %" TCL_SIZE_MODIFIER "d bytes", count*length)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } @@ -3084,23 +3131,24 @@ TclStringRepeat( Tcl_Obj * TclStringCat( Tcl_Interp *interp, - int objc, + Tcl_Size objc, Tcl_Obj * const objv[], int flags) { Tcl_Obj *objResultPtr, * const *ov; - int oc, binary = 1; - size_t length = 0; + int binary = 1; + Tcl_Size oc; + Tcl_Size length = 0; int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0; - int first = objc - 1; /* Index of first value possibly not empty */ - int last = 0; /* Index of last value possibly not empty */ - int inPlace = flags & TCL_STRING_IN_PLACE; + Tcl_Size first = objc - 1; /* Index of first value possibly not empty */ + Tcl_Size last = 0; /* Index of last value possibly not empty */ + int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv); /* assert ( objc >= 0 ) */ if (objc <= 1) { - /* Only one or no objects; return first or empty */ - return objc ? objv[0] : Tcl_NewObj(); + /* Negative (shouldn't be), one or no objects; return first or empty */ + return objc == 1 ? objv[0] : Tcl_NewObj(); } /* assert ( objc >= 2 ) */ @@ -3152,7 +3200,7 @@ TclStringCat( * Result will be pure byte array. Pre-size it */ - size_t numBytes = 0; + Tcl_Size numBytes = 0; ov = objv; oc = objc; do { @@ -3172,7 +3220,7 @@ TclStringCat( if (length == 0) { first = last; } - if (length > (TCL_SIZE_SMAX-numBytes)) { + if (length > (TCL_SIZE_MAX-numBytes)) { goto overflow; } length += numBytes; @@ -3190,7 +3238,7 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - size_t numChars; + Tcl_Size numChars; (void)Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */ if (numChars) { @@ -3198,7 +3246,7 @@ TclStringCat( if (length == 0) { first = last; } - if (length > ((TCL_SIZE_SMAX/sizeof(Tcl_UniChar))-numChars)) { + if (length > (Tcl_Size) ((TCL_SIZE_MAX/sizeof(Tcl_UniChar))-numChars)) { goto overflow; } length += numChars; @@ -3222,7 +3270,8 @@ TclStringCat( Tcl_Obj *objPtr = *ov++; - if (objPtr->bytes == NULL) { + if (objPtr->bytes == NULL + && TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) { /* No string rep; Take the chance we can avoid making it */ pendingPtr = objPtr; } else { @@ -3240,7 +3289,7 @@ TclStringCat( first = last = objc - oc - 1; if (oc && (length == 0)) { - size_t numBytes; + Tcl_Size numBytes; /* assert ( pendingPtr != NULL ) */ @@ -3265,7 +3314,7 @@ TclStringCat( if (numBytes) { first = last; } - } else if (numBytes > (TCL_SIZE_SMAX - length)) { + } else if (numBytes > (TCL_SIZE_MAX - length)) { goto overflow; } length += numBytes; @@ -3273,7 +3322,7 @@ TclStringCat( } while (oc && (length == 0)); while (oc) { - size_t numBytes; + Tcl_Size numBytes; Tcl_Obj *objPtr = *ov++; /* assert ( length > 0 && pendingPtr == NULL ) */ @@ -3282,7 +3331,7 @@ TclStringCat( numBytes = objPtr->length; if (numBytes) { last = objc - oc; - if (numBytes > (TCL_SIZE_SMAX - length)) { + if (numBytes > (TCL_SIZE_MAX - length)) { goto overflow; } length += numBytes; @@ -3298,6 +3347,7 @@ TclStringCat( } objv += first; objc = (last - first + 1); + inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv); if (binary) { /* Efficiently produce a pure byte array result */ @@ -3308,8 +3358,8 @@ TclStringCat( * failure to allocate enough space. Following stanza may panic. */ - if (inPlace && !Tcl_IsShared(*objv)) { - size_t start = 0; + if (inPlace) { + Tcl_Size start = 0; objResultPtr = *objv++; objc--; (void)Tcl_GetByteArrayFromObj(objResultPtr, &start); @@ -3328,7 +3378,7 @@ TclStringCat( */ if (TclIsPureByteArray(objPtr)) { - size_t more = 0; + Tcl_Size more = 0; unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more); memcpy(dst, src, more); dst += more; @@ -3338,8 +3388,8 @@ TclStringCat( /* Efficiently produce a pure Tcl_UniChar array result */ Tcl_UniChar *dst; - if (inPlace && !Tcl_IsShared(*objv)) { - size_t start; + if (inPlace) { + Tcl_Size start; objResultPtr = *objv++; objc--; @@ -3379,7 +3429,7 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - size_t more; + Tcl_Size more; Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more); memcpy(dst, src, more * sizeof(Tcl_UniChar)); dst += more; @@ -3389,8 +3439,8 @@ TclStringCat( /* Efficiently concatenate string reps */ char *dst; - if (inPlace && !Tcl_IsShared(*objv)) { - size_t start; + if (inPlace) { + Tcl_Size start; objResultPtr = *objv++; objc--; @@ -3426,7 +3476,7 @@ TclStringCat( Tcl_Obj *objPtr = *objv++; if ((objPtr->bytes == NULL) || (objPtr->length)) { - size_t more; + Tcl_Size more; char *src = Tcl_GetStringFromObj(objPtr, &more); memcpy(dst, src, more); @@ -3441,7 +3491,7 @@ TclStringCat( overflow: if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", TCL_SIZE_SMAX)); + "max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -3469,17 +3519,18 @@ TclStringCmp( Tcl_Obj *value2Ptr, int checkEq, /* comparison is only for equality */ int nocase, /* comparison is not case sensitive */ - size_t reqlength) /* requested length in characters; + Tcl_Size reqlength) /* requested length in characters; * TCL_INDEX_NONE to compare whole strings */ { const char *s1, *s2; int empty, match; - size_t length, s1len = 0, s2len = 0; + Tcl_Size length, s1len = 0, s2len = 0; memCmpFn_t memCmpFn; if ((reqlength == 0) || (value1Ptr == value2Ptr)) { /* * Always match at 0 chars of if it is the same obj. + * Note: as documented reqlength negative means it is ignored */ match = 0; } else { @@ -3534,7 +3585,7 @@ TclStringCmp( memCmpFn = memcmp; s1len *= sizeof(Tcl_UniChar); s2len *= sizeof(Tcl_UniChar); - if (reqlength != TCL_INDEX_NONE) { + if (reqlength > 0) { reqlength *= sizeof(Tcl_UniChar); } } else { @@ -3578,7 +3629,7 @@ TclStringCmp( s1 = Tcl_GetStringFromObj(value1Ptr, &s1len); s2 = Tcl_GetStringFromObj(value2Ptr, &s2len); } - if (!nocase && checkEq && reqlength == TCL_INDEX_NONE) { + if (!nocase && checkEq && reqlength < 0) { /* * When we have equal-length we can check only for * (in)equality. We can use memcmp in all (n)eq cases because @@ -3595,7 +3646,7 @@ TclStringCmp( * length was requested. */ - if ((reqlength == TCL_INDEX_NONE) && !nocase) { + if ((reqlength < 0) && !nocase) { memCmpFn = (memCmpFn_t) TclpUtfNcmp2; } else { s1len = Tcl_NumUtfChars(s1, s1len); @@ -3611,7 +3662,7 @@ TclStringCmp( * comparison function. */ length = (s1len < s2len) ? s1len : s2len; - if (reqlength == TCL_INDEX_NONE) { + if (reqlength < 0) { /* * The requested length is negative, so ignore it by setting it * to length + 1 to correct the match var. @@ -3622,7 +3673,7 @@ TclStringCmp( length = reqlength; } - if (checkEq && reqlength == TCL_INDEX_NONE && (s1len != s2len)) { + if (checkEq && reqlength < 0 && (s1len != s2len)) { match = 1; /* This will be reversed below. */ } else { /* @@ -3663,14 +3714,14 @@ Tcl_Obj * TclStringFirst( Tcl_Obj *needle, Tcl_Obj *haystack, - size_t start) + Tcl_Size start) { - size_t lh = 0, ln = Tcl_GetCharLength(needle); - size_t value = TCL_INDEX_NONE; + Tcl_Size lh = 0, ln = Tcl_GetCharLength(needle); + Tcl_Size value = -1; Tcl_UniChar *checkStr, *endStr, *uh, *un; Tcl_Obj *obj; - if (start == TCL_INDEX_NONE) { + if (start < 0) { start = 0; } if (ln == 0) { @@ -3770,10 +3821,10 @@ Tcl_Obj * TclStringLast( Tcl_Obj *needle, Tcl_Obj *haystack, - size_t last) + Tcl_Size last) { - size_t lh = 0, ln = Tcl_GetCharLength(needle); - size_t value = TCL_INDEX_NONE; + Tcl_Size lh = 0, ln = Tcl_GetCharLength(needle); + Tcl_Size value = -1; Tcl_UniChar *checkStr, *uh, *un; Tcl_Obj *obj; @@ -3791,7 +3842,7 @@ TclStringLast( unsigned char *check, *bh = Tcl_GetByteArrayFromObj(haystack, &lh); unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln); - if (last + 1 >= lh + 1) { + if (last >= lh) { last = lh - 1; } if (last + 1 < ln) { @@ -3814,7 +3865,7 @@ TclStringLast( uh = Tcl_GetUnicodeFromObj(haystack, &lh); un = Tcl_GetUnicodeFromObj(needle, &ln); - if (last + 1 >= lh + 1) { + if (last >= lh) { last = lh - 1; } if (last + 1 < ln) { @@ -3857,7 +3908,7 @@ static void ReverseBytes( unsigned char *to, /* Copy bytes into here... */ unsigned char *from, /* ...from here... */ - size_t count) /* Until this many are copied, */ + Tcl_Size count) /* Until this many are copied, */ /* reversing as you go. */ { unsigned char *src = from + count; @@ -3890,13 +3941,13 @@ TclStringReverse( #endif if (TclIsPureByteArray(objPtr)) { - size_t numBytes = 0; + Tcl_Size numBytes = 0; unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (!inPlace || Tcl_IsShared(objPtr)) { objPtr = Tcl_NewByteArrayObj(NULL, numBytes); } - ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL), from, numBytes); + ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL), from, numBytes); return objPtr; } @@ -3911,8 +3962,8 @@ TclStringReverse( if (!inPlace || Tcl_IsShared(objPtr)) { /* - * Create a non-empty, pure unicode value, so we can coax - * Tcl_SetObjLength into growing the unicode rep buffer. + * Create a non-empty, pure Unicode value, so we can coax + * Tcl_SetObjLength into growing the Unicode rep buffer. */ objPtr = Tcl_NewUnicodeObj(&ch, 1); @@ -3971,8 +4022,8 @@ TclStringReverse( } if (objPtr->bytes) { - size_t numChars = stringPtr->numChars; - size_t numBytes = objPtr->length; + Tcl_Size numChars = stringPtr->numChars; + Tcl_Size numBytes = objPtr->length; char *to, *from = objPtr->bytes; if (!inPlace || Tcl_IsShared(objPtr)) { @@ -3981,7 +4032,7 @@ TclStringReverse( } to = objPtr->bytes; - if ((numChars == TCL_INDEX_NONE) || (numChars < numBytes)) { + if (numChars < numBytes) { /* * Either numChars == -1 and we don't know how many chars are * represented by objPtr->bytes and we need Pass 1 just in case, @@ -3991,7 +4042,7 @@ TclStringReverse( * Pass 1. Reverse the bytes of each multi-byte character. */ - size_t bytesLeft = numBytes; + Tcl_Size bytesLeft = numBytes; int chw; while (bytesLeft) { @@ -4001,7 +4052,7 @@ TclStringReverse( * skip calling Tcl_UtfCharComplete() here. */ - size_t bytesInChar = TclUtfToUCS4(from, &chw); + int bytesInChar = TclUtfToUCS4(from, &chw); ReverseBytes((unsigned char *)to, (unsigned char *)from, bytesInChar); @@ -4049,8 +4100,8 @@ Tcl_Obj * TclStringReplace( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* String to act upon */ - size_t first, /* First index to replace */ - size_t count, /* How many chars to replace */ + Tcl_Size first, /* First index to replace */ + Tcl_Size count, /* How many chars to replace */ Tcl_Obj *insertPtr, /* Replacement string, may be NULL */ int flags) /* TCL_STRING_IN_PLACE => attempt in-place */ { @@ -4058,13 +4109,16 @@ TclStringReplace( Tcl_Obj *result; /* Replace nothing with nothing */ - if ((insertPtr == NULL) && (count == 0)) { + if ((insertPtr == NULL) && (count <= 0)) { if (inPlace) { return objPtr; } else { return Tcl_DuplicateObj(objPtr); } } + if (first < 0) { + first = 0; + } /* * The caller very likely had to call Tcl_GetCharLength() or similar @@ -4074,7 +4128,7 @@ TclStringReplace( */ if (TclIsPureByteArray(objPtr)) { - size_t numBytes = 0; + Tcl_Size numBytes = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes); if (insertPtr == NULL) { @@ -4097,7 +4151,7 @@ TclStringReplace( } if (TclIsPureByteArray(insertPtr)) { - size_t newBytes = 0; + Tcl_Size newBytes = 0; unsigned char *iBytes = Tcl_GetByteArrayFromObj(insertPtr, &newBytes); @@ -4112,11 +4166,11 @@ TclStringReplace( return objPtr; } - if (newBytes > (TCL_SIZE_SMAX - (numBytes - count))) { + if (newBytes > (TCL_SIZE_MAX - (numBytes - count))) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "max size for a Tcl value (%" TCL_Z_MODIFIER "u bytes) exceeded", - TCL_SIZE_SMAX)); + "max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", + TCL_SIZE_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; @@ -4142,7 +4196,7 @@ TclStringReplace( /* The traditional implementation... */ { - size_t numChars; + Tcl_Size numChars; Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars); /* TODO: Is there an in-place option worth pursuing here? */ @@ -4166,7 +4220,7 @@ TclStringReplace( * FillUnicodeRep -- * * Populate the Unicode internal rep with the Unicode form of its string - * rep. The object must alread have a "String" internal rep. + * rep. The object must already have a "String" internal rep. * * Results: * None. @@ -4192,11 +4246,11 @@ static void ExtendUnicodeRepWithString( Tcl_Obj *objPtr, const char *bytes, - size_t numBytes, - size_t numAppendChars) + Tcl_Size numBytes, + Tcl_Size numAppendChars) { String *stringPtr = GET_STRING(objPtr); - size_t needed, numOrigChars = 0; + Tcl_Size needed, numOrigChars = 0; Tcl_UniChar *dst, unichar = 0; if (stringPtr->hasUnicode) { @@ -4316,8 +4370,8 @@ DupStringInternalRep( * This operation always succeeds and returns TCL_OK. * * Side effects: - * Any old internal reputation for objPtr is freed and the internal - * representation is set to "String". + * Any old internal representation for objPtr is freed and the internal + * representation is set to &tclStringType. * *---------------------------------------------------------------------- */ @@ -4364,7 +4418,7 @@ SetStringFromAny( * None. * * Side effects: - * The object's string may be set by converting its Unicode represention + * The object's string may be set by converting its Unicode representation * to UTF format. * *---------------------------------------------------------------------- @@ -4394,21 +4448,21 @@ UpdateStringOfString( } } -static size_t +static Tcl_Size ExtendStringRepWithUnicode( Tcl_Obj *objPtr, const Tcl_UniChar *unicode, - size_t numChars) + Tcl_Size numChars) { /* - * Pre-condition: this is the "string" Tcl_ObjType. + * Precondition: this is the "string" Tcl_ObjType. */ - size_t i, origLength, size = 0; + Tcl_Size i, origLength, size = 0; char *dst; String *stringPtr = GET_STRING(objPtr); - if (numChars == TCL_INDEX_NONE) { + if (numChars < 0) { numChars = UnicodeLength(unicode); } @@ -4425,14 +4479,18 @@ ExtendStringRepWithUnicode( * Quick cheap check in case we have more than enough room. */ - if (numChars <= (INT_MAX - size)/TCL_UTF_MAX + if (numChars <= (TCL_SIZE_MAX - size)/TCL_UTF_MAX && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) { goto copyBytes; } - for (i = 0; i < numChars; i++) { + for (i = 0; i < numChars && size >= 0; i++) { + /* TODO - overflow check! I don't think check below at end suffices */ size += TclUtfCount(unicode[i]); } + if (size < 0) { + Tcl_Panic("max size for a Tcl value (%" TCL_SIZE_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX); + } /* * Grow space if needed. @@ -4444,6 +4502,14 @@ ExtendStringRepWithUnicode( copyBytes: dst = objPtr->bytes + origLength; +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(dst, 0xff, stringPtr->allocated - origLength); +#endif for (i = 0; i < numChars; i++) { dst += Tcl_UniCharToUtf(unicode[i], dst); } diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index ab52ea8096e5..768c1ee5da96 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -1,29 +1,12 @@ /* * tclStringRep.h -- * - * This file contains the definition of the Unicode string internal - * representation and macros to access it. + * This file contains the definition of internal representations of a string + * and macros to access it. * - * A Unicode string is an internationalized string. Conceptually, a - * Unicode string is an array of 16-bit quantities organized as a - * sequence of properly formed UTF-8 characters. There is a one-to-one - * map between Unicode and UTF characters. Because Unicode characters - * have a fixed width, operations such as indexing operate on Unicode - * data. The String object is optimized for the case where each UTF char - * in a string is only one byte. In this case, we store the value of - * numChars, but we don't store the Unicode data (unless Tcl_GetUnicode - * is explicitly called). - * - * The String object type stores one or both formats. The default - * behavior is to store UTF. Once Unicode is calculated by a function, it - * is stored in the internal rep for future access (without an additional - * O(n) cost). - * - * To allow many appends to be done to an object without constantly - * reallocating the space for the string or Unicode representation, we - * allocate double the space for the string or Unicode and use the - * internal representation to keep track of how much space is used vs. - * allocated. + * Conceptually, a string is a sequence of Unicode code points. Internally + * it may be stored in an encoding form such as a modified version of UTF-8 + * or UTF-16 (when TCL_UTF_MAX=3) or UTF-32. * * Copyright (c) 1995-1997 Sun Microsystems, Inc. * Copyright (c) 1999 by Scriptics Corporation. @@ -39,15 +22,10 @@ /* * The following structure is the internal rep for a String object. It keeps * track of how much memory has been used and how much has been allocated for - * the Unicode and UTF string to enable growing and shrinking of the UTF and - * Unicode reps of the String object with fewer mallocs. To optimize string + * the various representations to enable growing and shrinking of + * the String object with fewer mallocs. To optimize string * length and indexing operations, this structure also stores the number of - * characters (same of UTF and Unicode!) once that value has been computed. - * - * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16 - * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This - * can be officially modified by altering the definition of Tcl_UniChar in - * tcl.h, but do not do that unless you are sure what you're doing! + * code points (independent of encoding form) once that value has been computed. */ typedef struct { @@ -57,17 +35,21 @@ typedef struct { * Unicode rep, or that the number of UTF bytes == * the number of chars. */ Tcl_Size allocated; /* The amount of space actually allocated for - * the UTF string (minus 1 byte for the + * the UTF-8 string (minus 1 byte for the * termination char). */ Tcl_Size maxChars; /* Max number of chars that can fit in the - * space allocated for the unicode array. */ + * space allocated for the Unicode array. */ int hasUnicode; /* Boolean determining whether the string has - * a Unicode representation. */ - Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Unicode chars. The actual size - * of this field depends on the 'maxChars' - * field above. */ + * a Tcl_UniChar representation. */ + Tcl_UniChar unicode[TCLFLEXARRAY]; /* The array of Tcl_UniChar units. + * The actual size of this field depends on + * the maxChars field above. */ } String; +/* Limit on string lengths. The -1 because limit does not include the nul */ +#define STRING_MAXCHARS \ + ((Tcl_Size)((TCL_SIZE_MAX - offsetof(String, unicode))/sizeof(Tcl_UniChar) - 1)) +/* Memory needed to hold a string of length numChars - including NUL */ #define STRING_SIZE(numChars) \ (offsetof(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar))) #define stringAttemptAlloc(numChars) \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index dbd8b524d088..92632e86c72c 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -76,8 +76,18 @@ #undef Tcl_UniCharLen #undef TclObjInterpProc #if !defined(_WIN32) && !defined(__CYGWIN__) -#undef Tcl_WinConvertError -#define Tcl_WinConvertError 0 +# undef Tcl_WinConvertError +# define Tcl_WinConvertError 0 +#endif +#if defined(TCL_NO_DEPRECATED) +# undef TclGetStringFromObj +# undef TclGetBytesFromObj +# undef TclGetUnicodeFromObj +# define TclGetStringFromObj 0 +# define TclGetBytesFromObj 0 +# if TCL_UTF_MAX > 3 +# define TclGetUnicodeFromObj 0 +# endif #endif #undef Tcl_Close #define Tcl_Close 0 @@ -92,20 +102,29 @@ static void uniCodePanic() { Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX); } -# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, size_t *))(void *)uniCodePanic +# define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic # define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic -# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, size_t))(void *)uniCodePanic -# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic -# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic +# define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic +# define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic +# define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic #endif #define TclUtfCharComplete Tcl_UtfCharComplete #define TclUtfNext Tcl_UtfNext #define TclUtfPrev Tcl_UtfPrev +#if defined(TCL_NO_DEPRECATED) +# define TclListObjGetElements 0 +# define TclListObjLength 0 +# define TclDictObjSize 0 +# define TclSplitList 0 +# define TclSplitPath 0 +# define TclFSSplitPath 0 +# define TclParseArgsObjv 0 +#else /* !defined(TCL_NO_DEPRECATED) */ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *objcPtr, Tcl_Obj ***objvPtr) { - size_t n = TCL_INDEX_NONE; + void *objcPtr, Tcl_Obj ***objvPtr) { + Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { @@ -114,13 +133,13 @@ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, } return TCL_ERROR; } - *objcPtr = n; + *(int *)objcPtr = (int)n; } return result; } int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, - int *lengthPtr) { - size_t n = TCL_INDEX_NONE; + void *lengthPtr) { + Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjLength(interp, listPtr, &n); if (lengthPtr) { if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { @@ -129,13 +148,13 @@ int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, } return TCL_ERROR; } - *lengthPtr = n; + *(int *)lengthPtr = (int)n; } return result; } int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, - int *sizePtr) { - size_t n = TCL_INDEX_NONE; + void *sizePtr) { + Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_DictObjSize(interp, dictPtr, &n); if (sizePtr) { if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { @@ -144,13 +163,13 @@ int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, } return TCL_ERROR; } - *sizePtr = n; + *(int *)sizePtr = (int)n; } return result; } -int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, +int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr) { - size_t n = TCL_INDEX_NONE; + Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_SplitList(interp, listStr, &n, argvPtr); if (argcPtr) { if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) { @@ -160,12 +179,12 @@ int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, Tcl_Free((void *)*argvPtr); return TCL_ERROR; } - *argcPtr = n; + *(int *)argcPtr = (int)n; } return result; } -void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) { - size_t n = TCL_INDEX_NONE; +void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) { + Tcl_Size n = TCL_INDEX_NONE; Tcl_SplitPath(path, &n, argvPtr); if (argcPtr) { if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) { @@ -173,29 +192,30 @@ void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) { Tcl_Free((void *)*argvPtr); *argvPtr = NULL; } - *argcPtr = n; + *(int *)argcPtr = (int)n; } } -Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) { - size_t n = TCL_INDEX_NONE; +Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) { + Tcl_Size n = TCL_INDEX_NONE; Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n); if (lenPtr) { if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) { Tcl_DecrRefCount(result); return NULL; } - *lenPtr = n; + *(int *)lenPtr = (int)n; } return result; } int TclParseArgsObjv(Tcl_Interp *interp, - const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, + const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) { - size_t n = (*objcPtr < 0) ? TCL_INDEX_NONE: (size_t)*objcPtr ; + Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ; int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); - *objcPtr = (int)n; + *(int *)objcPtr = (int)n; return result; } +#endif /* !defined(TCL_NO_DEPRECATED) */ #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d @@ -337,7 +357,7 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ *ptr = (int)longValue; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", TCL_INDEX_NONE)); + "integer value too large to represent", -1)); result = TCL_ERROR; } } @@ -353,7 +373,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ *ptr = (int)longValue; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "integer value too large to represent", TCL_INDEX_NONE)); + "integer value too large to represent", -1)); result = TCL_ERROR; } } @@ -1492,8 +1512,9 @@ const TclStubs tclStubs = { Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ - 0, /* 686 */ - TclUnusedStubEntry, /* 687 */ + Tcl_GetSizeIntFromObj, /* 686 */ + 0, /* 687 */ + TclUnusedStubEntry, /* 688 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 74fd620facc1..b35abe051a0c 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -224,7 +224,8 @@ static Tcl_ObjCmdProc TestbytestringObjCmd; static Tcl_ObjCmdProc TestsetbytearraylengthObjCmd; static Tcl_ObjCmdProc TestpurebytesobjObjCmd; static Tcl_ObjCmdProc TeststringbytesObjCmd; -static Tcl_CmdProc TestcmdinfoCmd; +static Tcl_ObjCmdProc2 Testcmdobj2ObjCmd; +static Tcl_ObjCmdProc TestcmdinfoObjCmd; static Tcl_CmdProc TestcmdtokenCmd; static Tcl_CmdProc TestcmdtraceCmd; static Tcl_CmdProc TestconcatobjCmd; @@ -334,6 +335,7 @@ static Tcl_ObjCmdProc TestFindFirstCmd; static Tcl_ObjCmdProc TestFindLastCmd; static Tcl_ObjCmdProc TestHashSystemHashCmd; static Tcl_ObjCmdProc TestGetIntForIndexCmd; +static Tcl_ObjCmdProc TestLutilCmd; static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; @@ -585,7 +587,9 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL, + Tcl_CreateObjCommand2(interp, "testcmdobj2", Testcmdobj2ObjCmd, + NULL, NULL); + Tcl_CreateObjCommand(interp, "testcmdinfo", TestcmdinfoObjCmd, NULL, NULL); Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd, NULL, NULL); @@ -722,6 +726,8 @@ Tcltest_Init( NULL, NULL); Tcl_CreateObjCommand(interp, "testapplylambda", TestApplyLambdaObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testlutil", TestLutilCmd, + NULL, NULL); if (TclObjTest_Init(interp) != TCL_OK) { return TCL_ERROR; @@ -920,7 +926,7 @@ TestasyncCmd( break; } } - Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1)); Tcl_MutexUnlock(&asyncTestMutex); return code; } else if (strcmp(argv[1], "marklater") == 0) { @@ -1058,7 +1064,41 @@ TestbumpinterpepochObjCmd( /* *---------------------------------------------------------------------- * - * TestcmdinfoCmd -- + * Testcmdobj2 -- + * + * Mock up to test the Tcl_CreateCommandObj2 functionality + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Sets interpreter result to number of arguments, first arg, last arg. + * + *---------------------------------------------------------------------- + */ + +static int +Testcmdobj2ObjCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Size objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Obj *resultObj; + resultObj = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewWideIntObj(objc)); + if (objc > 1) { + Tcl_ListObjAppendElement(interp, resultObj, objv[1]); + Tcl_ListObjAppendElement(interp, resultObj, objv[objc-1]); + } + Tcl_SetObjResult(interp, resultObj); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestcmdinfoObjCmd -- * * This procedure implements the "testcmdinfo" command. It is used to * test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and @@ -1074,28 +1114,69 @@ TestbumpinterpepochObjCmd( */ static int -TestcmdinfoCmd( +TestcmdinfoObjCmd( TCL_UNUSED(void *), 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 objects. */ { + static const char *const subcmds[] = { + "call", "call2", "create", "delete", "get", "modify", NULL + }; + enum options { + CMDINFO_CALL, CMDINFO_CALL2, CMDINFO_CREATE, + CMDINFO_DELETE, CMDINFO_GET, CMDINFO_MODIFY + } idx; Tcl_CmdInfo info; + Tcl_Obj **cmdObjv; + Tcl_Size cmdObjc; - if (argc != 3) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " option cmdName\"", NULL); + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "command arg"); return TCL_ERROR; } - if (strcmp(argv[1], "create") == 0) { - Tcl_CreateCommand(interp, argv[2], CmdProc1, (void *) "original", - CmdDelProc1); - } else if (strcmp(argv[1], "delete") == 0) { + if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, + &idx) != TCL_OK) { + return TCL_ERROR; + } + switch (idx) { + case CMDINFO_CALL: + case CMDINFO_CALL2: + if (Tcl_ListObjGetElements(interp, objv[2], &cmdObjc, &cmdObjv) != TCL_OK) { + return TCL_ERROR; + } + if (cmdObjc == 0) { + Tcl_AppendResult(interp, "No command name given", NULL); + return TCL_ERROR; + } + if (Tcl_GetCommandInfo(interp, Tcl_GetString(cmdObjv[0]), &info) == 0) { + return TCL_ERROR; + } + if (idx == CMDINFO_CALL) { + /* + * Note when calling through the old 32-bit API, it is the caller's + * responsibility to check that number of arguments is <= INT_MAX. + * We do not do that here just so we can test what happens if the + * caller mistakenly passes more arguments. + */ + return info.objProc(info.objClientData, interp, cmdObjc, cmdObjv); + } else { + return info.objProc2(info.objClientData2, interp, cmdObjc, cmdObjv); + } + case CMDINFO_CREATE: + Tcl_CreateCommand(interp, + Tcl_GetString(objv[2]), + CmdProc1, + (void *)"original", + CmdDelProc1); + break; + case CMDINFO_DELETE: Tcl_DStringInit(&delString); - Tcl_DeleteCommand(interp, argv[2]); + Tcl_DeleteCommand(interp, Tcl_GetString(objv[2])); Tcl_DStringResult(interp, &delString); - } else if (strcmp(argv[1], "get") == 0) { - if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) { + break; + case CMDINFO_GET: + if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) { Tcl_AppendResult(interp, "??", NULL); return TCL_OK; } @@ -1118,28 +1199,35 @@ TestcmdinfoCmd( Tcl_AppendResult(interp, " unknown", NULL); } Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL); - if (info.isNativeObjectProc) { + if (info.isNativeObjectProc == 0) { + Tcl_AppendResult(interp, " stringProc", NULL); + } else if (info.isNativeObjectProc == 1) { Tcl_AppendResult(interp, " nativeObjectProc", NULL); + } else if (info.isNativeObjectProc == 2) { + Tcl_AppendResult(interp, " nativeObjectProc2", NULL); } else { - Tcl_AppendResult(interp, " stringProc", NULL); + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("Invalid isNativeObjectProc value %d", + info.isNativeObjectProc)); + return TCL_ERROR; } - } else if (strcmp(argv[1], "modify") == 0) { + break; + case CMDINFO_MODIFY: info.proc = CmdProc2; info.clientData = (void *) "new_command_data"; info.objProc = NULL; info.objClientData = NULL; info.deleteProc = CmdDelProc2; info.deleteData = (void *) "new_delete_data"; - if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) { + if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1)); } - } else { - Tcl_AppendResult(interp, "bad option \"", argv[1], - "\": must be create, delete, get, or modify", NULL); - return TCL_ERROR; + break; } + return TCL_OK; } @@ -1166,7 +1254,6 @@ CmdProc1( return TCL_OK; } - static int CmdProc2( void *clientData, /* String to return. */ @@ -1205,8 +1292,8 @@ CmdDelProc1( void *clientData) /* String to save. */ { Tcl_DStringInit(&delString); - Tcl_DStringAppend(&delString, "CmdDelProc1 ", TCL_INDEX_NONE); - Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE); + Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1); + Tcl_DStringAppend(&delString, (char *) clientData, -1); } static void @@ -1214,8 +1301,8 @@ CmdDelProc2( void *clientData) /* String to save. */ { Tcl_DStringInit(&delString); - Tcl_DStringAppend(&delString, "CmdDelProc2 ", TCL_INDEX_NONE); - Tcl_DStringAppend(&delString, (char *) clientData, TCL_INDEX_NONE); + Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1); + Tcl_DStringAppend(&delString, (char *) clientData, -1); } /* @@ -1243,8 +1330,8 @@ TestcmdtokenCmd( const char **argv) /* Argument strings. */ { TestCommandTokenRef *refPtr; - char buf[30]; int id; + char buf[30]; if (argc != 3) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -1260,7 +1347,7 @@ TestcmdtokenCmd( nextCommandTokenRefId++; refPtr->nextPtr = firstCommandTokenRef; firstCommandTokenRef = refPtr; - sprintf(buf, "%d", refPtr->id); + snprintf(buf, sizeof(buf), "%d", refPtr->id); Tcl_AppendResult(interp, buf, NULL); } else { if (sscanf(argv[2], "%d", &id) != 1) { @@ -1468,7 +1555,7 @@ ObjTraceProc( const char *word = Tcl_GetString(objv[0]); if (!strcmp(word, "Error")) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(command, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1)); return TCL_ERROR; } else if (!strcmp(word, "Break")) { return TCL_BREAK; @@ -1832,7 +1919,7 @@ TestdoubledigitsObjCmd( type = types[type]; if (objc > 4) { if (strcmp(Tcl_GetString(objv[4]), "shorten")) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1)); return TCL_ERROR; } type |= TCL_DD_SHORTEST; @@ -2029,7 +2116,23 @@ static int UtfExtWrapper( int result; int flags; Tcl_Obj **flagObjs; - int nflags; + Tcl_Size nflags; + static const struct { + const char *flagKey; + int flag; + } flagMap[] = { + {"start", TCL_ENCODING_START}, + {"end", TCL_ENCODING_END}, + {"stoponerror", TCL_ENCODING_STOPONERROR}, + {"noterminate", TCL_ENCODING_NO_TERMINATE}, + {"charlimit", TCL_ENCODING_CHAR_LIMIT}, + {"profiletcl8", TCL_ENCODING_PROFILE_TCL8}, + {"profilestrict", TCL_ENCODING_PROFILE_STRICT}, + {"profilereplace", TCL_ENCODING_PROFILE_REPLACE}, + {NULL, 0} + }; + Tcl_Size i; + Tcl_WideInt wide; if (objc < 7 || objc > 10) { Tcl_WrongNumArgs(interp, @@ -2048,21 +2151,6 @@ static int UtfExtWrapper( return TCL_ERROR; } - struct { - const char *flagKey; - int flag; - } flagMap[] = { - {"start", TCL_ENCODING_START}, - {"end", TCL_ENCODING_END}, - {"stoponerror", TCL_ENCODING_STOPONERROR}, - {"noterminate", TCL_ENCODING_NO_TERMINATE}, - {"charlimit", TCL_ENCODING_CHAR_LIMIT}, - {"profiletcl8", TCL_ENCODING_PROFILE_TCL8}, - {"profilestrict", TCL_ENCODING_PROFILE_STRICT}, - {"profilereplace", TCL_ENCODING_PROFILE_REPLACE}, - {NULL, 0} - }; - int i; for (i = 0; i < nflags; ++i) { int flag; if (Tcl_GetIntFromObj(NULL, flagObjs[i], &flag) == TCL_OK) { @@ -2083,7 +2171,6 @@ static int UtfExtWrapper( } /* Assumes state is integer if not "" */ - Tcl_WideInt wide; if (Tcl_GetWideIntFromObj(interp, objv[5], &wide) == TCL_OK) { encState = (Tcl_EncodingState)(size_t)wide; encStatePtr = &encState; @@ -2153,19 +2240,19 @@ static int UtfExtWrapper( Tcl_Obj *resultObjs[3]; switch (result) { case TCL_OK: - resultObjs[0] = Tcl_NewStringObj("ok", -1); + resultObjs[0] = Tcl_NewStringObj("ok", TCL_INDEX_NONE); break; case TCL_CONVERT_MULTIBYTE: - resultObjs[0] = Tcl_NewStringObj("multibyte", -1); + resultObjs[0] = Tcl_NewStringObj("multibyte", TCL_INDEX_NONE); break; case TCL_CONVERT_SYNTAX: - resultObjs[0] = Tcl_NewStringObj("syntax", -1); + resultObjs[0] = Tcl_NewStringObj("syntax", TCL_INDEX_NONE); break; case TCL_CONVERT_UNKNOWN: - resultObjs[0] = Tcl_NewStringObj("unknown", -1); + resultObjs[0] = Tcl_NewStringObj("unknown", TCL_INDEX_NONE); break; case TCL_CONVERT_NOSPACE: - resultObjs[0] = Tcl_NewStringObj("nospace", -1); + resultObjs[0] = Tcl_NewStringObj("nospace", TCL_INDEX_NONE); break; default: resultObjs[0] = Tcl_NewIntObj(result); @@ -2235,7 +2322,7 @@ TestencodingObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Encoding encoding; - size_t length; + Tcl_Size length; const char *string; TclEncoding *encodingPtr; static const char *const optionStrings[] = { @@ -2263,7 +2350,7 @@ TestencodingObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "name toutfcmd fromutfcmd"); return TCL_ERROR; } - encodingPtr = (TclEncoding*)Tcl_Alloc(sizeof(TclEncoding)); + encodingPtr = (TclEncoding *)Tcl_Alloc(sizeof(TclEncoding)); encodingPtr->interp = interp; string = Tcl_GetStringFromObj(objv[3], &length); @@ -2419,7 +2506,8 @@ TestevalexObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int length, flags; + int flags; + Tcl_Size length; const char *script; flags = 0; @@ -2723,7 +2811,7 @@ ExitProcOdd( char buf[16 + TCL_INTEGER_SPACE]; int len; - sprintf(buf, "odd %d\n", (int)PTR2INT(clientData)); + snprintf(buf, sizeof(buf), "odd %d\n", (int)PTR2INT(clientData)); len = strlen(buf); if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcOdd: unable to write to stdout"); @@ -2737,7 +2825,7 @@ ExitProcEven( char buf[16 + TCL_INTEGER_SPACE]; int len; - sprintf(buf, "even %d\n", (int)PTR2INT(clientData)); + snprintf(buf, sizeof(buf), "even %d\n", (int)PTR2INT(clientData)); len = strlen(buf); if (len != (int) write(1, buf, len)) { Tcl_Panic("ExitProcEven: unable to write to stdout"); @@ -2782,7 +2870,7 @@ TestexprlongCmd( if (result != TCL_OK) { return result; } - sprintf(buf, ": %ld", exprResult); + snprintf(buf, sizeof(buf), ": %ld", exprResult); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } @@ -2824,7 +2912,7 @@ TestexprlongobjCmd( if (result != TCL_OK) { return result; } - sprintf(buf, ": %ld", exprResult); + snprintf(buf, sizeof(buf), ": %ld", exprResult); Tcl_AppendResult(interp, buf, NULL); return TCL_OK; } @@ -3058,7 +3146,7 @@ TestgetassocdataCmd( * TestgetplatformCmd -- * * This procedure implements the "testgetplatform" command. It is - * used to retrievel the value of the tclPlatform global variable. + * used to retrieve the value of the tclPlatform global variable. * * Results: * A standard Tcl result. @@ -3425,7 +3513,7 @@ TestlinkCmd( } } if (argv[6][0] != 0) { - tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE); + tmp = Tcl_NewStringObj(argv[6], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3483,7 +3571,7 @@ TestlinkCmd( } if (argv[15][0]) { Tcl_WideInt w; - tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE); + tmp = Tcl_NewStringObj(argv[15], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3533,7 +3621,7 @@ TestlinkCmd( Tcl_UpdateLinkedVar(interp, "string"); } if (argv[6][0] != 0) { - tmp = Tcl_NewStringObj(argv[6], TCL_INDEX_NONE); + tmp = Tcl_NewStringObj(argv[6], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3600,7 +3688,7 @@ TestlinkCmd( } if (argv[15][0]) { Tcl_WideInt w; - tmp = Tcl_NewStringObj(argv[15], TCL_INDEX_NONE); + tmp = Tcl_NewStringObj(argv[15], -1); if (Tcl_GetWideIntFromObj(interp, tmp, &w) != TCL_OK) { Tcl_DecrRefCount(tmp); return TCL_ERROR; @@ -3657,7 +3745,8 @@ TestlinkarrayCmd( TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS, TCL_LINK_BINARY }; - int typeIndex, readonly, i, size, length; + int typeIndex, readonly, i, size; + Tcl_Size length; char *name, *arg; Tcl_WideInt addr; @@ -3707,7 +3796,7 @@ TestlinkarrayCmd( return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1)); return TCL_ERROR; } name = Tcl_GetString(objv[i++]); @@ -3719,7 +3808,7 @@ TestlinkarrayCmd( if (i < objc) { if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "wrong address value", TCL_INDEX_NONE)); + "wrong address value", -1)); return TCL_ERROR; } } else { @@ -3819,7 +3908,7 @@ TestlistrepCmd( #define APPEND_FIELD(targetObj_, structPtr_, fld_) \ do { \ Tcl_ListObjAppendElement( \ - interp, (targetObj_), Tcl_NewStringObj(#fld_, TCL_INDEX_NONE)); \ + interp, (targetObj_), Tcl_NewStringObj(#fld_, -1)); \ Tcl_ListObjAppendElement( \ interp, (targetObj_), Tcl_NewWideIntObj((structPtr_)->fld_)); \ } while (0) @@ -3837,10 +3926,10 @@ TestlistrepCmd( return TCL_ERROR; } ListObjGetRep(objv[2], &listRep); - listRepObjs[0] = Tcl_NewStringObj("store", TCL_INDEX_NONE); + listRepObjs[0] = Tcl_NewStringObj("store", -1); listRepObjs[1] = Tcl_NewListObj(12, NULL); Tcl_ListObjAppendElement( - interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE)); + interp, listRepObjs[1], Tcl_NewStringObj("memoryAddress", -1)); Tcl_ListObjAppendElement( interp, listRepObjs[1], Tcl_ObjPrintf("%p", listRep.storePtr)); APPEND_FIELD(listRepObjs[1], listRep.storePtr, firstUsed); @@ -3849,11 +3938,11 @@ TestlistrepCmd( APPEND_FIELD(listRepObjs[1], listRep.storePtr, refCount); APPEND_FIELD(listRepObjs[1], listRep.storePtr, flags); if (listRep.spanPtr) { - listRepObjs[2] = Tcl_NewStringObj("span", TCL_INDEX_NONE); + listRepObjs[2] = Tcl_NewStringObj("span", -1); listRepObjs[3] = Tcl_NewListObj(8, NULL); Tcl_ListObjAppendElement(interp, listRepObjs[3], - Tcl_NewStringObj("memoryAddress", TCL_INDEX_NONE)); + Tcl_NewStringObj("memoryAddress", -1)); Tcl_ListObjAppendElement( interp, listRepObjs[3], Tcl_ObjPrintf("%p", listRep.spanPtr)); APPEND_FIELD(listRepObjs[3], listRep.spanPtr, spanStart); @@ -3873,7 +3962,7 @@ TestlistrepCmd( } resultObj = Tcl_NewListObj(2, NULL); Tcl_ListObjAppendElement( - NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", TCL_INDEX_NONE)); + NULL, resultObj, Tcl_NewStringObj("LIST_SPAN_THRESHOLD", -1)); Tcl_ListObjAppendElement( NULL, resultObj, Tcl_NewWideIntObj(LIST_SPAN_THRESHOLD)); break; @@ -3947,7 +4036,7 @@ TestlocaleCmd( } locale = setlocale(lcTypes[index], locale); if (locale) { - Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, TCL_INDEX_NONE); + Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1); } return TCL_OK; } @@ -4002,7 +4091,8 @@ TestparserObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int length, dummy; + Tcl_Size dummy; + int length; Tcl_Parse parse; if (objc != 3) { @@ -4058,7 +4148,8 @@ TestexprparserObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int length, dummy; + Tcl_Size dummy; + int length; Tcl_Parse parse; if (objc != 3) { @@ -4120,7 +4211,7 @@ PrintParse( Tcl_Obj *objPtr; const char *typeString; Tcl_Token *tokenPtr; - size_t i; + Tcl_Size i; objPtr = Tcl_GetObjResult(interp); if (parsePtr->commentSize + 1 > 1) { @@ -4134,7 +4225,7 @@ PrintParse( Tcl_NewStringObj(parsePtr->commandStart, parsePtr->commandSize)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(parsePtr->numWords)); - for (i = 0; i < (size_t)parsePtr->numTokens; i++) { + for (i = 0; i < parsePtr->numTokens; i++) { tokenPtr = &parsePtr->tokenPtr[i]; switch (tokenPtr->type) { case TCL_TOKEN_EXPAND_WORD: @@ -4169,7 +4260,7 @@ PrintParse( break; } Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewStringObj(typeString, TCL_INDEX_NONE)); + Tcl_NewStringObj(typeString, -1)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj(tokenPtr->start, tokenPtr->size)); Tcl_ListObjAppendElement(NULL, objPtr, @@ -4247,7 +4338,8 @@ TestparsevarnameObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { const char *script; - int append, length, dummy; + int length, append; + Tcl_Size dummy; Tcl_Parse parse; if (objc != 4) { @@ -4380,8 +4472,8 @@ TestregexpObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int i, indices, stringLength, match, about; - Tcl_Size ii; + int i, indices, match, about; + Tcl_Size stringLength, ii; int hasxflags, cflags, eflags; Tcl_RegExp regExpr; const char *string; @@ -4498,7 +4590,7 @@ TestregexpObjCmd( varName = Tcl_GetString(objv[2]); TclRegExpRangeUniChar(regExpr, TCL_INDEX_NONE, &start, &end); - sprintf(resinfo, "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, end-1); + snprintf(resinfo, sizeof(resinfo), "%" TCL_Z_MODIFIER "d %" TCL_Z_MODIFIER "d", start, end-1); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", @@ -4512,7 +4604,7 @@ TestregexpObjCmd( Tcl_RegExpGetInfo(regExpr, &info); varName = Tcl_GetString(objv[2]); - sprintf(resinfo, "%" TCL_Z_MODIFIER "d", info.extendStart); + snprintf(resinfo, sizeof(resinfo), "%" TCL_Z_MODIFIER "d", info.extendStart); value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0); if (value == NULL) { Tcl_AppendResult(interp, "couldn't set variable \"", @@ -4819,7 +4911,7 @@ TestsetplatformCmd( * A standard Tcl result. * * Side effects: - * When the packge given by argv[1] is loaded into an interpreter, + * When the package given by argv[1] is loaded into an interpreter, * variable "x" in that interpreter is set to "loaded". * *---------------------------------------------------------------------- @@ -5285,7 +5377,7 @@ TestgetvarfullnameCmd( * * This procedure implements the "gettimes" command. It is used for * computing the time needed for various basic operations such as reading - * variables, allocating memory, sprintf, converting variables, etc. + * variables, allocating memory, snprintf, converting variables, etc. * * Results: * A standard Tcl result. @@ -5367,7 +5459,7 @@ GetTimesObjCmd( /* TclGetString 100000 times */ fprintf(stderr, "Tcl_GetStringFromObj of \"12345\" 100000 times\n"); - objPtr = Tcl_NewStringObj("12345", TCL_INDEX_NONE); + objPtr = Tcl_NewStringObj("12345", -1); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { (void) TclGetString(objPtr); @@ -5404,15 +5496,15 @@ GetTimesObjCmd( fprintf(stderr, " %.3f usec per Tcl_GetInt of \"12345\"\n", timePer/100000); - /* sprintf 100000 times */ - fprintf(stderr, "sprintf of 12345 100000 times\n"); + /* snprintf 100000 times */ + fprintf(stderr, "snprintf of 12345 100000 times\n"); Tcl_GetTime(&start); for (i = 0; i < 100000; i++) { - sprintf(newString, "%d", 12345); + snprintf(newString, sizeof(newString), "%d", 12345); } Tcl_GetTime(&stop); timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec); - fprintf(stderr, " %.3f usec per sprintf of 12345\n", + fprintf(stderr, " %.3f usec per snprintf of 12345\n", timePer/100000); /* hashtable lookup 100000 times */ @@ -5534,7 +5626,7 @@ TeststringbytesObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - int n; + Tcl_Size n; const unsigned char *p; if (objc != 2) { @@ -5670,7 +5762,14 @@ TestbytestringObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { - size_t n = 0; + struct { +#if !defined(TCL_NO_DEPRECATED) + int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */ +#else + Tcl_Size n; +#endif + int m; /* This variable should not be overwritten */ + } x = {0, 1}; const char *p; if (objc != 2) { @@ -5678,11 +5777,15 @@ TestbytestringObjCmd( return TCL_ERROR; } - p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n); + p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n); if (p == NULL) { return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n)); + if (x.m != 1) { + Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n)); return TCL_OK; } @@ -5919,7 +6022,7 @@ TestChannelCmd( Tcl_Channel chan; /* The opaque type. */ size_t len; /* Length of subcommand string. */ int IOQueued; /* How much IO is queued inside channel? */ - char buf[TCL_INTEGER_SPACE];/* For sprintf. */ + char buf[TCL_INTEGER_SPACE];/* For snprintf. */ int mode; /* rw mode of the channel */ if (argc < 2) { @@ -5970,7 +6073,7 @@ TestChannelCmd( if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) { - Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE); + Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1); Tcl_IncrRefCount(msg); Tcl_SetChannelError(chan, msg); @@ -5983,7 +6086,7 @@ TestChannelCmd( } if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) { - Tcl_Obj *msg = Tcl_NewStringObj(argv[3], TCL_INDEX_NONE); + Tcl_Obj *msg = Tcl_NewStringObj(argv[3], -1); Tcl_IncrRefCount(msg); Tcl_SetChannelErrorInterp(interp, msg); @@ -6370,7 +6473,7 @@ TestChannelCmd( } return TclChannelTransform(interp, chan, - Tcl_NewStringObj(argv[4], TCL_INDEX_NONE)); + Tcl_NewStringObj(argv[4], -1)); } if ((cmdName[0] == 'u') && (strncmp(cmdName, "unstack", len) == 0)) { @@ -6461,7 +6564,7 @@ TestChannelEventCmd( esPtr->chanPtr = chanPtr; esPtr->interp = interp; esPtr->mask = mask; - esPtr->scriptPtr = Tcl_NewStringObj(argv[4], TCL_INDEX_NONE); + esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1); Tcl_IncrRefCount(esPtr->scriptPtr); Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask, @@ -6528,10 +6631,10 @@ TestChannelEventCmd( esPtr = esPtr->nextPtr) { if (esPtr->mask) { Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( - (esPtr->mask == TCL_READABLE) ? "readable" : "writable", TCL_INDEX_NONE)); + (esPtr->mask == TCL_READABLE) ? "readable" : "writable", -1)); } else { Tcl_ListObjAppendElement(interp, resultListPtr, - Tcl_NewStringObj("none", TCL_INDEX_NONE)); + Tcl_NewStringObj("none", -1)); } Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr); } @@ -6758,7 +6861,7 @@ TestWrongNumArgsObjCmd( Tcl_Size i, length; const char *msg; - if (objc + 1 < 4) { + if (objc < 3) { goto insufArgs; } @@ -6833,10 +6936,10 @@ TestGetIndexFromObjStructObjCmd( return TCL_ERROR; } else if (idx[1] != target) { char buffer[64]; - sprintf(buffer, "%d", idx[1]); + snprintf(buffer, sizeof(buffer), "%d", idx[1]); Tcl_AppendResult(interp, "index value comparison failed: got ", buffer, NULL); - sprintf(buffer, "%d", target); + snprintf(buffer, sizeof(buffer), "%d", target); Tcl_AppendResult(interp, " when ", buffer, " expected", NULL); return TCL_ERROR; } @@ -6886,7 +6989,7 @@ TestFilesystemObjCmd( res = Tcl_FSUnregister(&testReportingFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1)); return res; } @@ -6968,7 +7071,7 @@ TestReport( Tcl_DString ds; Tcl_DStringInit(&ds); - Tcl_DStringAppend(&ds, "lappend filesystemReport ", TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1); Tcl_DStringStartSublist(&ds); Tcl_DStringAppendElement(&ds, cmd); if (path != NULL) { @@ -7257,7 +7360,7 @@ TestSimpleFilesystemObjCmd( res = Tcl_FSUnregister(&simpleFilesystem); msg = (res == TCL_OK) ? "unregistered" : "failed"; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1)); return res; } @@ -7270,7 +7373,7 @@ static Tcl_Obj * SimpleRedirect( Tcl_Obj *pathPtr) /* Name of file to copy. */ { - int len; + Tcl_Size len; const char *str; Tcl_Obj *origPtr; @@ -7284,7 +7387,7 @@ SimpleRedirect( Tcl_IncrRefCount(pathPtr); return pathPtr; } - origPtr = Tcl_NewStringObj(str+10, TCL_INDEX_NONE); + origPtr = Tcl_NewStringObj(str+10, -1); Tcl_IncrRefCount(origPtr); return origPtr; } @@ -7316,7 +7419,7 @@ SimpleMatchInDirectory( origPtr = SimpleRedirect(dirPtr); res = Tcl_FSMatchInDirectory(interp, resPtr, origPtr, pattern, types); if (res == TCL_OK) { - size_t gLength, j; + Tcl_Size gLength, j; Tcl_ListObjLength(NULL, resPtr, &gLength); for (j = 0; j < gLength; j++) { Tcl_Obj *gElt, *nElt; @@ -7384,7 +7487,7 @@ SimpleListVolumes(void) /* Add one new volume */ Tcl_Obj *retVal; - retVal = Tcl_NewStringObj("simplefs:/", TCL_INDEX_NONE); + retVal = Tcl_NewStringObj("simplefs:/", -1); Tcl_IncrRefCount(retVal); return retVal; } @@ -7402,7 +7505,7 @@ TestUtfNextCmd( int objc, Tcl_Obj *const objv[]) { - size_t numBytes; + Tcl_Size numBytes; char *bytes; const char *result, *first; char buffer[32]; @@ -7415,7 +7518,7 @@ TestUtfNextCmd( } bytes = Tcl_GetStringFromObj(objv[1], &numBytes); - if (numBytes + 4U > sizeof(buffer)) { + if (numBytes + 4 > (Tcl_Size) sizeof(buffer)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "\"testutfnext\" can only handle %" TCL_Z_MODIFIER "u bytes", sizeof(buffer) - 4)); @@ -7538,7 +7641,7 @@ TestFindFirstCmd( if (objc > 2) { (void) Tcl_GetIntFromObj(interp, objv[2], &len); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1)); } return TCL_OK; } @@ -7560,7 +7663,7 @@ TestFindLastCmd( if (objc > 2) { (void) Tcl_GetIntFromObj(interp, objv[2], &len); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1)); } return TCL_OK; } @@ -7638,7 +7741,7 @@ TestcpuidCmd( status = TclWinCPUID(index, regs); if (status != TCL_OK) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("operation not available", TCL_INDEX_NONE)); + Tcl_NewStringObj("operation not available", -1)); return status; } for (i=0 ; i<4 ; ++i) { @@ -7684,7 +7787,7 @@ TestHashSystemHashCmd( hPtr = Tcl_CreateHashEntry(&hash, INT2PTR(i), &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i)); - Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem", -1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } @@ -7701,13 +7804,13 @@ TestHashSystemHashCmd( hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i)); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(i)); - Tcl_AppendToObj(Tcl_GetObjResult(interp)," lookup problem", TCL_INDEX_NONE); + 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_NewWideIntObj(i)); - Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp)," value problem", -1); Tcl_DeleteHashTable(&hash); return TCL_ERROR; } @@ -7860,7 +7963,7 @@ TestNRELevels( * * This procedure implements the "testconcatobj" command. It is used * to test that Tcl_ConcatObj does indeed return a fresh Tcl_Obj in all - * cases and thet it never corrupts its arguments. In other words, that + * cases and that it never corrupts its arguments. In other words, that * [Bug 1447328] was fixed properly. * * Results: @@ -7881,7 +7984,7 @@ TestconcatobjCmd( { Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr; int result = TCL_OK; - size_t len; + Tcl_Size len; Tcl_Obj *objv[3]; /* @@ -7890,15 +7993,15 @@ TestconcatobjCmd( */ Tcl_SetObjResult(interp, - Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", TCL_INDEX_NONE)); + Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1)); emptyPtr = Tcl_NewObj(); - list1Ptr = Tcl_NewStringObj("foo bar sum", TCL_INDEX_NONE); + list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); Tcl_InvalidateStringRep(list1Ptr); - list2Ptr = Tcl_NewStringObj("eeny meeny", TCL_INDEX_NONE); + list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); Tcl_InvalidateStringRep(list2Ptr); @@ -8238,7 +8341,7 @@ TestparseargsCmd( Tcl_Obj *const objv[]) /* Arguments. */ { static int foo = 0; - size_t count = objc; + Tcl_Size count = objc; Tcl_Obj **remObjv, *result[3]; Tcl_ArgvInfo argTable[] = { {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL}, @@ -8266,7 +8369,7 @@ InterpCmdResolver( Tcl_Interp *interp, const char *name, TCL_UNUSED(Tcl_Namespace *), - TCL_UNUSED(int) /*flags*/, + TCL_UNUSED(int) /* flags */, Tcl_Command *rPtr) { Interp *iPtr = (Interp *) interp; @@ -8451,7 +8554,7 @@ static int InterpCompiledVarResolver( TCL_UNUSED(Tcl_Interp *), const char *name, - TCL_UNUSED(Tcl_Size) /*length*/, + TCL_UNUSED(Tcl_Size) /* length */, TCL_UNUSED(Tcl_Namespace *), Tcl_ResolvedVarInfo **rPtr) { @@ -8461,7 +8564,7 @@ InterpCompiledVarResolver( resVarInfo->vInfo.fetchProc = MyCompiledVarFetch; resVarInfo->vInfo.deleteProc = MyCompiledVarFree; resVarInfo->var = NULL; - resVarInfo->nameObj = Tcl_NewStringObj(name, TCL_INDEX_NONE); + resVarInfo->nameObj = Tcl_NewStringObj(name, -1); Tcl_IncrRefCount(resVarInfo->nameObj); *rPtr = &resVarInfo->vInfo; return TCL_OK; @@ -8545,12 +8648,12 @@ int TestApplyLambdaObjCmd ( /* Create a lambda {{} {set a 42}} */ lambdaObjs[0] = Tcl_NewObj(); /* No parameters */ - lambdaObjs[1] = Tcl_NewStringObj("set a 42", TCL_INDEX_NONE); /* Body */ + lambdaObjs[1] = Tcl_NewStringObj("set a 42", -1); /* Body */ lambdaObj = Tcl_NewListObj(2, lambdaObjs); Tcl_IncrRefCount(lambdaObj); /* Create the command "apply {{} {set a 42}" */ - evalObjs[0] = Tcl_NewStringObj("apply", TCL_INDEX_NONE); + evalObjs[0] = Tcl_NewStringObj("apply", -1); Tcl_IncrRefCount(evalObjs[0]); /* * NOTE: IMPORTANT TO EXHIBIT THE BUG. We duplicate the lambda because @@ -8590,6 +8693,102 @@ int TestApplyLambdaObjCmd ( return result; } +/* + *---------------------------------------------------------------------- + * + * TestLutilCmd -- + * + * This procedure implements the "testlequal" command. It is used to + * test compare two lists for equality using the string representation + * of each element. Implemented in C because script level loops are + * too slow for comparing large (GB count) lists. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestLutilCmd( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Arguments. */ +{ + Tcl_Size nL1, nL2; + Tcl_Obj *l1Obj = NULL; + Tcl_Obj *l2Obj = NULL; + Tcl_Obj **l1Elems; + Tcl_Obj **l2Elems; + static const char *const subcmds[] = { + "equal", "diffindex", NULL + }; + enum options { + LUTIL_EQUAL, LUTIL_DIFFINDEX + } idx; + + if (objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "list1 list2"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, + &idx) != TCL_OK) { + return TCL_ERROR; + } + + /* Protect against shimmering, just to be safe */ + l1Obj = Tcl_DuplicateObj(objv[2]); + l2Obj = Tcl_DuplicateObj(objv[3]); + + int ret = TCL_ERROR; + if (Tcl_ListObjGetElements(interp, l1Obj, &nL1, &l1Elems) != TCL_OK) { + goto vamoose; + } + if (Tcl_ListObjGetElements(interp, l2Obj, &nL2, &l2Elems) != TCL_OK) { + goto vamoose; + } + + Tcl_Size i, nCmp; + + ret = TCL_OK; + switch (idx) { + case LUTIL_EQUAL: + /* Avoid the loop below if lengths differ */ + if (nL1 != nL2) { + Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); + break; + } + /* FALLTHRU */ + case LUTIL_DIFFINDEX: + nCmp = nL1 <= nL2 ? nL1 : nL2; + for (i = 0; i < nCmp; ++i) { + if (strcmp(Tcl_GetString(l1Elems[i]), Tcl_GetString(l2Elems[i]))) { + break; + } + } + if (i == nCmp && nCmp == nL1 && nCmp == nL2) { + nCmp = idx == LUTIL_EQUAL ? 1 : -1; + } else { + nCmp = idx == LUTIL_EQUAL ? 0 : i; + } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(nCmp)); + break; + } + +vamoose: + if (l1Obj) { + Tcl_DecrRefCount(l1Obj); + } + if (l2Obj) { + Tcl_DecrRefCount(l2Obj); + } + return ret; +} + /* * Local Variables: * mode: c diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index 42a96daaf175..e801a2d8c477 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -25,15 +25,16 @@ #endif #include "tclStringRep.h" +#include /* * Forward declarations for functions defined later in this file: */ -static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, size_t varIndex); +static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, Tcl_Size varIndex); static int GetVariableIndex(Tcl_Interp *interp, - Tcl_Obj *obj, size_t *indexPtr); -static void SetVarToObj(Tcl_Obj **varPtr, size_t varIndex, Tcl_Obj *objPtr); + Tcl_Obj *obj, Tcl_Size *indexPtr); +static void SetVarToObj(Tcl_Obj **varPtr, Tcl_Size varIndex, Tcl_Obj *objPtr); static Tcl_ObjCmdProc TestbignumobjCmd; static Tcl_ObjCmdProc TestbooleanobjCmd; static Tcl_ObjCmdProc TestdoubleobjCmd; @@ -42,6 +43,7 @@ static Tcl_ObjCmdProc TestintobjCmd; static Tcl_ObjCmdProc TestlistobjCmd; static Tcl_ObjCmdProc TestobjCmd; static Tcl_ObjCmdProc TeststringobjCmd; +static Tcl_ObjCmdProc TestbigdataCmd; #define VARPTR_KEY "TCLOBJTEST_VARPTR" #define NUMBER_OF_OBJECT_VARS 20 @@ -117,6 +119,8 @@ TclObjTest_Init( Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testbigdata", TestbigdataCmd, + NULL, NULL); return TCL_OK; } @@ -153,7 +157,7 @@ TestbignumobjCmd( BIGNUM_RADIXSIZE } idx; int index; - size_t varIndex; + Tcl_Size varIndex; const char *string; mp_int bignumValue; Tcl_Obj **varPtr; @@ -180,13 +184,13 @@ TestbignumobjCmd( string = Tcl_GetString(objv[3]); if (mp_init(&bignumValue) != MP_OKAY) { Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_init", TCL_INDEX_NONE)); + Tcl_NewStringObj("error in mp_init", -1)); return TCL_ERROR; } if (mp_read_radix(&bignumValue, string, 10) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_read_radix", TCL_INDEX_NONE)); + Tcl_NewStringObj("error in mp_read_radix", -1)); return TCL_ERROR; } @@ -230,7 +234,7 @@ TestbignumobjCmd( if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_mul_d", TCL_INDEX_NONE)); + Tcl_NewStringObj("error in mp_mul_d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -255,7 +259,7 @@ TestbignumobjCmd( if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_div_d", TCL_INDEX_NONE)); + Tcl_NewStringObj("error in mp_div_d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -280,7 +284,7 @@ TestbignumobjCmd( if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) { mp_clear(&bignumValue); Tcl_SetObjResult(interp, - Tcl_NewStringObj("error in mp_mod_2d", TCL_INDEX_NONE)); + Tcl_NewStringObj("error in mp_mod_2d", -1)); return TCL_ERROR; } if (!Tcl_IsShared(varPtr[varIndex])) { @@ -344,7 +348,7 @@ TestbooleanobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; int boolValue; const char *subCmd; Tcl_Obj **varPtr; @@ -444,7 +448,7 @@ TestdoubleobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; double doubleValue; const char *subCmd; Tcl_Obj **varPtr; @@ -561,7 +565,7 @@ TestindexobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { int allowAbbrev, index, setError, i, result; - Tcl_WideInt index2; + Tcl_Size index2; const char **argv; static const char *const tablePtr[] = {"a", "b", "check", NULL}; @@ -570,8 +574,8 @@ TestindexobjCmd( */ struct IndexRep { void *tablePtr; /* Pointer to the table of strings. */ - TCL_HASH_TYPE offset; /* Offset between table entries. */ - TCL_HASH_TYPE index; /* Selected index into table. */ + Tcl_Size offset; /* Offset between table entries. */ + Tcl_Size index; /* Selected index into table. */ } *indexRep; if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), @@ -582,7 +586,7 @@ TestindexobjCmd( * lookups. */ - if (Tcl_GetWideIntFromObj(interp, objv[2], &index2) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[2], TCL_INDEX_NONE, &index2) != TCL_OK) { return TCL_ERROR; } @@ -592,13 +596,13 @@ TestindexobjCmd( result = Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index); if (result == TCL_OK) { - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(index + 1U)) - 1); } return result; } if (objc < 5) { - Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", -1); return TCL_ERROR; } @@ -620,7 +624,7 @@ TestindexobjCmd( &index); Tcl_Free((void *)argv); if (result == TCL_OK) { - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(index + 1U)) - 1); } return result; } @@ -650,7 +654,7 @@ TestintobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex; + Tcl_Size varIndex; #if (INT_MAX != LONG_MAX) /* int is not the same size as long */ int i; #endif @@ -738,7 +742,7 @@ TestintobjCmd( return TCL_ERROR; } Tcl_AppendToObj(Tcl_GetObjResult(interp), - ((wideValue == WIDE_MAX)? "1" : "0"), TCL_INDEX_NONE); + ((wideValue == WIDE_MAX)? "1" : "0"), -1); } else if (strcmp(subCmd, "get") == 0) { if (objc != 3) { goto wrongNumArgs; @@ -754,7 +758,7 @@ TestintobjCmd( if (CheckIfVarUnset(interp, varPtr,varIndex)) { return TCL_ERROR; } - Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1); } else if (strcmp(subCmd, "inttoobigtest") == 0) { /* * If long ints have more bits than ints on this platform, verify that @@ -767,7 +771,7 @@ TestintobjCmd( goto wrongNumArgs; } #if (INT_MAX == LONG_MAX) /* int is same size as long int */ - Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); #else if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetWideIntObj(varPtr[varIndex], LONG_MAX); @@ -776,10 +780,10 @@ TestintobjCmd( } if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) { Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1); return TCL_OK; } - Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1); #endif } else if (strcmp(subCmd, "mult10") == 0) { if (objc != 3) { @@ -895,11 +899,11 @@ TestlistobjCmd( LISTOBJ_GETELEMENTSMEMCHECK, } cmdIndex; - size_t varIndex; /* Variable number converted to binary */ - Tcl_WideInt first; /* First index in the list */ - Tcl_WideInt count; /* Count of elements in a list */ + Tcl_Size varIndex; /* Variable number converted to binary */ + Tcl_Size first; /* First index in the list */ + Tcl_Size count; /* Count of elements in a list */ Tcl_Obj **varPtr; - int i, len; + Tcl_Size i, len; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?"); @@ -913,7 +917,7 @@ TestlistobjCmd( 0, &cmdIndex) != TCL_OK) { return TCL_ERROR; } - switch (cmdIndex) { + switch(cmdIndex) { case LISTOBJ_SET: if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) { Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3); @@ -940,8 +944,8 @@ TestlistobjCmd( "varIndex start count ?element...?"); return TCL_ERROR; } - if (Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK - || Tcl_GetWideIntFromObj(interp, objv[4], &count) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK + || Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &count) != TCL_OK) { return TCL_ERROR; } if (Tcl_IsShared(varPtr[varIndex])) { @@ -1028,7 +1032,7 @@ TestobjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t varIndex, destIndex; + Tcl_Size varIndex, destIndex; int i; const Tcl_ObjType *targetType; Tcl_Obj **varPtr; @@ -1104,7 +1108,7 @@ TestobjCmd( const char *typeName; if (objv[2]->typePtr == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("none", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1)); } else { typeName = objv[2]->typePtr->name; if (!strcmp(typeName, "utf32string")) @@ -1112,7 +1116,7 @@ TestobjCmd( #ifndef TCL_WIDE_INT_IS_LONG else if (!strcmp(typeName, "wideInt")) typeName = "int"; #endif - Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1)); } } return TCL_OK; @@ -1199,22 +1203,22 @@ TestobjCmd( if (objc != 3) { goto wrongNumArgs; } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount)); + Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)((Tcl_WideUInt)(varPtr[varIndex]->refCount + 1U)) - 1)); break; case TESTOBJ_TYPE: if (objc != 3) { goto wrongNumArgs; } if (varPtr[varIndex]->typePtr == NULL) { /* a string! */ - Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1); #ifndef TCL_WIDE_INT_IS_LONG } else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) { Tcl_AppendToObj(Tcl_GetObjResult(interp), - "int", TCL_INDEX_NONE); + "int", -1); #endif } else { Tcl_AppendToObj(Tcl_GetObjResult(interp), - varPtr[varIndex]->typePtr->name, TCL_INDEX_NONE); + varPtr[varIndex]->typePtr->name, -1); } break; default: @@ -1250,9 +1254,9 @@ TeststringobjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_UniChar *unicode; - size_t size, varIndex; + Tcl_Size size, varIndex; int option, i; - Tcl_WideInt length; + Tcl_Size length; #define MAX_STRINGS 11 const char *string, *strings[MAX_STRINGS+1]; String *strPtr; @@ -1283,7 +1287,7 @@ TeststringobjCmd( if (objc != 5) { goto wrongNumArgs; } - if (Tcl_GetWideIntFromObj(interp, objv[4], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] == NULL) { @@ -1345,7 +1349,7 @@ TeststringobjCmd( if (CheckIfVarUnset(interp, varPtr, varIndex)) { return TCL_ERROR; } - Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_GetString(varPtr[varIndex]), -1); break; case 4: /* length */ if (objc != 3) { @@ -1364,9 +1368,9 @@ TeststringobjCmd( strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->allocated; } else { - length = -1; + length = TCL_INDEX_NONE; } - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(length + 1U)) - 1); break; case 6: /* set */ if (objc != 4) { @@ -1401,7 +1405,7 @@ TeststringobjCmd( if (objc != 4) { goto wrongNumArgs; } - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &length) != TCL_OK) { return TCL_ERROR; } if (varPtr[varIndex] != NULL) { @@ -1418,17 +1422,17 @@ TeststringobjCmd( strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1; length = strPtr->maxChars; } else { - length = -1; + length = TCL_INDEX_NONE; } - Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length); + Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)((Tcl_WideUInt)(length + 1U)) - 1); break; case 10: { /* range */ - Tcl_WideInt first, last; + Tcl_Size first, last; if (objc != 5) { goto wrongNumArgs; } - if ((Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK) - || (Tcl_GetWideIntFromObj(interp, objv[4], &last) != TCL_OK)) { + if ((Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) + || (Tcl_GetIntForIndex(interp, objv[4], TCL_INDEX_NONE, &last) != TCL_OK)) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last)); @@ -1453,12 +1457,12 @@ TeststringobjCmd( string = Tcl_GetStringFromObj(varPtr[varIndex], &size); - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) { + if (length == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "index value out of range", TCL_INDEX_NONE)); + "index value out of range", -1)); return TCL_ERROR; } @@ -1484,12 +1488,12 @@ TeststringobjCmd( unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size); - if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, objv[3], size-1, &length) != TCL_OK) { return TCL_ERROR; } - if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) { + if (length == TCL_INDEX_NONE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "index value out of range", TCL_INDEX_NONE)); + "index value out of range", -1)); return TCL_ERROR; } @@ -1518,6 +1522,144 @@ TeststringobjCmd( return TCL_OK; } +/* + *------------------------------------------------------------------------ + * + * TestbigdataCmd -- + * + * Implements the Tcl command testbigdata + * testbigdata string ?LEN? ?SPLIT? - returns 01234567890123... + * testbigdata bytearray ?LEN? ?SPLIT? - returns {0 1 2 3 4 5 6 7 8 9 0 1 ...} + * testbigdata dict ?SIZE? - returns dict mapping integers to themselves + * If no arguments given, returns the pattern used to generate strings. + * If SPLIT is specified, the character at that position is set to "X". + * + * Results: + * TCL_OK - Success. + * TCL_ERROR - Error. + * + * Side effects: + * Interpreter result holds result or error message. + * + *------------------------------------------------------------------------ + */ +static int +TestbigdataCmd ( + TCL_UNUSED(void *), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + static const char *const subcmds[] = { + "string", "bytearray", "list", "dict", NULL + }; + enum options { + BIGDATA_STRING, BIGDATA_BYTEARRAY, BIGDATA_LIST, BIGDATA_DICT + } idx; + char *s; + unsigned char *p; + Tcl_WideInt i, len, split; + Tcl_DString ds; + Tcl_Obj *objPtr; +#define PATTERN_LEN 10 + Tcl_Obj *patternObjs[PATTERN_LEN]; + + if (objc < 2 || objc > 4) { + Tcl_WrongNumArgs(interp, 1, objv, "command ?len? ?split?"); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0, + &idx) != TCL_OK) { + return TCL_ERROR; + } + split = -1; + if (objc == 2) { + len = PATTERN_LEN; + } else { + if (Tcl_GetWideIntFromObj(interp, objv[2], &len) != TCL_OK) { + return TCL_ERROR; + } + if (objc == 4) { + if (Tcl_GetWideIntFromObj(interp, objv[3], &split) != TCL_OK) { + return TCL_ERROR; + } + if (split >= len) { + split = len - 1; /* Last position */ + } + } + } + /* Need one byte for nul terminator */ + Tcl_WideInt limit = + sizeof(Tcl_Size) == sizeof(Tcl_WideInt) ? WIDE_MAX-1 : INT_MAX-1; + if (len < 0 || len > limit) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf( + "%s is greater than max permitted length %" TCL_LL_MODIFIER "d", + Tcl_GetString(objv[2]), + limit)); + return TCL_ERROR; + } + + switch (idx) { + case BIGDATA_STRING: + Tcl_DStringInit(&ds); + Tcl_DStringSetLength(&ds, len);/* Also stores \0 at index len+1 */ + s = Tcl_DStringValue(&ds); + for (i = 0; i < len; ++i) { + s[i] = '0' + (i % PATTERN_LEN); + } + if (split >= 0) { + assert(split < len); + s[split] = 'X'; + } + Tcl_DStringResult(interp, &ds); + break; + case BIGDATA_BYTEARRAY: + objPtr = Tcl_NewByteArrayObj(NULL, len); + p = Tcl_GetByteArrayFromObj(objPtr, &len); + for (i = 0; i < len; ++i) { + p[i] = '0' + (i % PATTERN_LEN); + } + if (split >= 0) { + assert(split < len); + p[split] = 'X'; + } + Tcl_SetObjResult(interp, objPtr); + break; + case BIGDATA_LIST: + for (i = 0; i < PATTERN_LEN; ++i) { + patternObjs[i] = Tcl_NewIntObj(i); + Tcl_IncrRefCount(patternObjs[i]); + } + objPtr = Tcl_NewListObj(len, NULL); + for (i = 0; i < len; ++i) { + Tcl_ListObjAppendElement( + interp, objPtr, patternObjs[i % PATTERN_LEN]); + } + if (split >= 0) { + assert(split < len); + Tcl_Obj *splitMarker = Tcl_NewStringObj("X", 1); + Tcl_ListObjReplace(interp, objPtr, split, 1, 1, &splitMarker); + } + for (i = 0; i < PATTERN_LEN; ++i) { + patternObjs[i] = Tcl_NewIntObj(i); + Tcl_DecrRefCount(patternObjs[i]); + } + Tcl_SetObjResult(interp, objPtr); + break; + case BIGDATA_DICT: + objPtr = Tcl_NewDictObj(); + for (i = 0; i < len; ++i) { + Tcl_Obj *objPtr2 = Tcl_NewWideIntObj(i); + Tcl_DictObjPut(interp, objPtr, objPtr2, objPtr2); + } + Tcl_SetObjResult(interp, objPtr); + break; + } + return TCL_OK; +} + /* *---------------------------------------------------------------------- * @@ -1540,7 +1682,7 @@ TeststringobjCmd( static void SetVarToObj( Tcl_Obj **varPtr, - size_t varIndex, /* Designates the assignment variable. */ + Tcl_Size varIndex, /* Designates the assignment variable. */ Tcl_Obj *objPtr) /* Points to object to assign to var. */ { if (varPtr[varIndex] != NULL) { @@ -1574,16 +1716,16 @@ GetVariableIndex( Tcl_Obj *obj, /* The variable index * specified as a nonnegative number less than * NUMBER_OF_OBJECT_VARS. */ - size_t *indexPtr) /* Place to store converted result. */ + Tcl_Size *indexPtr) /* Place to store converted result. */ { - Tcl_WideInt index; + Tcl_Size index; - if (Tcl_GetWideIntFromObj(interp, obj, &index) != TCL_OK) { + if (Tcl_GetIntForIndex(interp, obj, NUMBER_OF_OBJECT_VARS - 1, &index) != TCL_OK) { return TCL_ERROR; } - if (index < 0 || index >= NUMBER_OF_OBJECT_VARS) { + if (index == TCL_INDEX_NONE) { Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), "bad variable index", -1); return TCL_ERROR; } @@ -1613,14 +1755,14 @@ static int CheckIfVarUnset( Tcl_Interp *interp, /* Interpreter for error reporting. */ Tcl_Obj ** varPtr, - size_t varIndex) /* Index of the test variable to check. */ + Tcl_Size varIndex) /* Index of the test variable to check. */ { if (varPtr[varIndex] == NULL) { char buf[32 + TCL_INTEGER_SPACE]; - sprintf(buf, "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex); + snprintf(buf, sizeof(buf), "variable %" TCL_Z_MODIFIER "u is unset (NULL)", varIndex); Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, TCL_INDEX_NONE); + Tcl_AppendToObj(Tcl_GetObjResult(interp), buf, -1); return 1; } return 0; diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c index 8d92c6ec1f9d..381ff02fbbd7 100644 --- a/generic/tclTestProcBodyObj.c +++ b/generic/tclTestProcBodyObj.c @@ -144,14 +144,14 @@ RegisterCommand( char buf[128]; if (cmdTablePtr->exportIt) { - sprintf(buf, "namespace eval %s { namespace export %s }", + snprintf(buf, sizeof(buf), "namespace eval %s { namespace export %s }", namesp, cmdTablePtr->cmdName); if (Tcl_EvalEx(interp, buf, TCL_INDEX_NONE, 0) != TCL_OK) { return TCL_ERROR; } } - sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName); + snprintf(buf, sizeof(buf), "%s::%s", namesp, cmdTablePtr->cmdName); Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0); return TCL_OK; } diff --git a/generic/tclThread.c b/generic/tclThread.c index 70a2b05a78e8..b72de4aa1820 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -61,7 +61,7 @@ static void RememberSyncObject(void *objPtr, void * Tcl_GetThreadData( Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */ - size_t size) /* Size of storage block */ + Tcl_Size size) /* Size of storage block */ { void *result; #if TCL_THREADS diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 1eb63155ecb0..011d61bd9f5e 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -640,11 +640,11 @@ Tcl_GetMemoryInfo( if (cachePtr == sharedPtr) { Tcl_DStringAppendElement(dsPtr, "shared"); } else { - sprintf(buf, "thread%p", cachePtr->owner); + snprintf(buf, sizeof(buf), "thread%p", cachePtr->owner); Tcl_DStringAppendElement(dsPtr, buf); } for (n = 0; n < NBUCKETS; ++n) { - sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" + snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u", bucketInfo[n].blockSize, cachePtr->buckets[n].numFree, @@ -937,7 +937,7 @@ GetBlocks( size_t n; /* - * First, atttempt to move blocks from the shared cache. Note the + * First, attempt to move blocks from the shared cache. Note the * potentially dirty read of numFree before acquiring the lock which is a * slight performance enhancement. The value is verified after the lock is * actually acquired. diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 5781329038c6..c87a7ba533bb 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -272,7 +272,8 @@ ThreadObjCmd( } case THREAD_CREATE: { const char *script; - int joinable, len; + int joinable; + Tcl_Size len; if (objc == 2) { /* @@ -367,7 +368,7 @@ ThreadObjCmd( } else { char buf[TCL_INTEGER_SPACE]; - sprintf(buf, "%" TCL_LL_MODIFIER "d", (long long)id); + snprintf(buf, sizeof(buf), "%" TCL_LL_MODIFIER "d", (long long)id); Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); } return result; @@ -649,15 +650,15 @@ ThreadErrorProc( char *script; char buf[TCL_DOUBLE_SPACE+1]; - sprintf(buf, "%p", Tcl_GetCurrentThread()); + snprintf(buf, sizeof(buf), "%p", Tcl_GetCurrentThread()); errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); if (errorProcString == NULL) { errChannel = Tcl_GetStdChannel(TCL_STDERR); - Tcl_WriteChars(errChannel, "Error from thread ", TCL_INDEX_NONE); - Tcl_WriteChars(errChannel, buf, TCL_INDEX_NONE); + Tcl_WriteChars(errChannel, "Error from thread ", -1); + Tcl_WriteChars(errChannel, buf, -1); Tcl_WriteChars(errChannel, "\n", 1); - Tcl_WriteChars(errChannel, errorInfo, TCL_INDEX_NONE); + Tcl_WriteChars(errChannel, errorInfo, -1); Tcl_WriteChars(errChannel, "\n", 1); } else { argv[0] = errorProcString; @@ -822,7 +823,7 @@ ThreadSend( } /* - * Short circut sends to ourself. Ought to do something with -async, like + * Short circuit sends to ourself. Ought to do something with -async, like * run in an idle handler. */ @@ -982,7 +983,7 @@ ThreadCancel( Tcl_MutexUnlock(&threadMutex); Tcl_ResetResult(interp); return Tcl_CancelEval(tsdPtr->interp, - (result != NULL) ? Tcl_NewStringObj(result, TCL_INDEX_NONE) : NULL, 0, flags); + (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags); } /* diff --git a/generic/tclTimer.c b/generic/tclTimer.c index 3b4741e0bcd7..0d17fa5904de 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -787,7 +787,7 @@ Tcl_AfterObjCmd( Tcl_Time wakeup; AfterInfo *afterPtr; AfterAssocData *assocPtr; - size_t length; + Tcl_Size length; int index = -1; static const char *const afterSubCmds[] = { "cancel", "idle", "info", NULL @@ -882,7 +882,7 @@ Tcl_AfterObjCmd( case AFTER_CANCEL: { Tcl_Obj *commandPtr; const char *command, *tempCommand; - size_t tempLength; + Tcl_Size tempLength; if (objc < 3) { Tcl_WrongNumArgs(interp, 2, objv, "id|command"); @@ -974,7 +974,7 @@ Tcl_AfterObjCmd( Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr); Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( - (afterPtr->token == NULL) ? "idle" : "timer", TCL_INDEX_NONE)); + (afterPtr->token == NULL) ? "idle" : "timer", -1)); Tcl_SetObjResult(interp, resultListPtr); } break; diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h index 40a4e9d93918..26db0820e92c 100644 --- a/generic/tclTomMath.h +++ b/generic/tclTomMath.h @@ -24,6 +24,14 @@ # define MP_VAL -3 /* invalid input */ # define MP_ITER -4 /* maximum iterations reached */ # define MP_BUF -5 /* buffer overflow, supplied buffer too small */ + typedef int mp_order; +# define MP_LSB_FIRST -1 +# define MP_MSB_FIRST 1 + typedef int mp_endian; +# define MP_LITTLE_ENDIAN -1 +# define MP_NATIVE_ENDIAN 0 +# define MP_BIG_ENDIAN 1 +# define MP_DEPRECATED_PRAGMA(s) /* nothing */ # define MP_WUR /* nothing */ # define mp_iszero(a) ((a)->used == 0) # define mp_isneg(a) ((a)->sign != 0) diff --git a/generic/tclTrace.c b/generic/tclTrace.c index daeb42454ffe..a527fcce6705 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -269,7 +269,8 @@ Tcl_TraceObjCmd( case TRACE_OLD_VDELETE: { Tcl_Obj *copyObjv[6]; Tcl_Obj *opsList; - int code, numFlags; + int code; + Tcl_Size numFlags; if (objc != 5) { Tcl_WrongNumArgs(interp, 2, objv, "name ops command"); @@ -1104,7 +1105,7 @@ Tcl_CommandTraceInfo( * * Side effects: * A trace is set up on the command given by cmdName, such that future - * changes to the command will be intermediated by proc. See the manual + * changes to the command will be mediated by proc. See the manual * entry for complete details on the calling sequence for proc. * *---------------------------------------------------------------------- @@ -2928,7 +2929,7 @@ Tcl_UntraceVar2( * 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. */ + Tcl_VarTraceProc *proc, /* Function associated with trace. */ void *clientData) /* Arbitrary argument to pass to proc. */ { VarTrace *tracePtr; @@ -3056,7 +3057,7 @@ Tcl_VarTraceInfo2( * as-a-whole. */ int flags, /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY. */ - Tcl_VarTraceProc *proc, /* Function assocated with trace. */ + Tcl_VarTraceProc *proc, /* Function associated with trace. */ void *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 @@ -3114,7 +3115,7 @@ Tcl_VarTraceInfo2( * * Side effects: * A trace is set up on the variable given by part1 and part2, such that - * future references to the variable will be intermediated by proc. See + * future references to the variable will be mediated by proc. See * the manual entry for complete details on the calling sequence for * proc. The variable's flags are updated. * @@ -3167,7 +3168,7 @@ Tcl_TraceVar2( * * Side effects: * A trace is set up on the variable given by part1 and part2, such that - * future references to the variable will be intermediated by the + * future references to the variable will be mediated by the * traceProc listed in tracePtr. See the manual entry for complete * details on the calling sequence for proc. * diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 1fb8847c7884..68112c5e3b5b 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -105,7 +105,7 @@ static int Invalid(const char *src); *--------------------------------------------------------------------------- */ -size_t +int TclUtfCount( int ch) /* The Unicode character whose size is returned. */ { @@ -205,7 +205,7 @@ Invalid( */ #undef Tcl_UniCharToUtf -size_t +Tcl_Size Tcl_UniCharToUtf( int ch, /* The Tcl_UniChar to be stored in the * buffer. Can be or'ed with flag TCL_COMBINE @@ -318,13 +318,14 @@ Tcl_UniCharToUtf( char * Tcl_UniCharToUtfDString( const int *uniStr, /* Unicode string to convert to UTF-8. */ - size_t uniLength, /* Length of Unicode string. */ + Tcl_Size uniLength, /* Length of Unicode string. Negative for nul + * nul terminated string */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { const int *w, *wEnd; char *p, *string; - size_t oldLength; + Tcl_Size oldLength; /* * UTF-8 string length in bytes will be <= Unicode string length * 4. @@ -333,7 +334,7 @@ Tcl_UniCharToUtfDString( if (uniStr == NULL) { return NULL; } - if (uniLength == TCL_INDEX_NONE) { + if (uniLength < 0) { uniLength = 0; w = uniStr; while (*w != '\0') { @@ -347,6 +348,16 @@ Tcl_UniCharToUtfDString( p = string; wEnd = uniStr + uniLength; + +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its + * prior non-stateful nature, this call to memset can also be removed. + */ + memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength); +#endif + for (w = uniStr; w < wEnd; ) { p += Tcl_UniCharToUtf(*w, p); w++; @@ -359,7 +370,7 @@ Tcl_UniCharToUtfDString( char * Tcl_Char16ToUtfDString( const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */ - size_t uniLength, /* Length of Utf-16 string. */ + Tcl_Size uniLength, /* Length of Utf-16 string. */ Tcl_DString *dsPtr) /* UTF-8 representation of string is appended * to this previously initialized DString. */ { @@ -375,7 +386,7 @@ Tcl_Char16ToUtfDString( if (uniStr == NULL) { return NULL; } - if (uniLength == TCL_INDEX_NONE) { + if (uniLength < 0) { uniLength = 0; w = uniStr; @@ -390,6 +401,16 @@ Tcl_Char16ToUtfDString( p = string; wEnd = uniStr + uniLength; + +#if TCL_UTF_MAX < 4 + /* Initialize the buffer so that some random data doesn't trick + * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs. + * Because TCL_COMBINE is used here, memset() is required even when + * TCL_UTF_MAX == 4. + */ + memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength); +#endif + for (w = uniStr; w < wEnd; ) { if (!len && ((*w & 0xFC00) != 0xDC00)) { /* Special case for handling high surrogates. */ @@ -453,7 +474,7 @@ static const unsigned short cp1252[32] = { }; #undef Tcl_UtfToUniChar -size_t +Tcl_Size Tcl_UtfToUniChar( const char *src, /* The UTF-8 string. */ int *chPtr)/* Filled with the Unicode character represented by @@ -536,7 +557,7 @@ Tcl_UtfToUniChar( return 1; } -size_t +Tcl_Size Tcl_UtfToChar16( const char *src, /* The UTF-8 string. */ unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by @@ -657,7 +678,7 @@ Tcl_UtfToChar16( int * Tcl_UtfToUniCharDString( const char *src, /* UTF-8 string to convert to Unicode. */ - size_t length, /* Length of UTF-8 string in bytes, or -1 for + Tcl_Size length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized @@ -665,7 +686,7 @@ Tcl_UtfToUniCharDString( { int ch = 0, *w, *wString; const char *p; - size_t oldLength; + Tcl_Size oldLength; /* Pointer to the end of string. Never read endPtr[0] */ const char *endPtr = src + length; /* Pointer to last byte where optimization still can be used */ @@ -674,7 +695,7 @@ Tcl_UtfToUniCharDString( if (src == NULL) { return NULL; } - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = strlen(src); } @@ -714,7 +735,7 @@ Tcl_UtfToUniCharDString( unsigned short * Tcl_UtfToChar16DString( const char *src, /* UTF-8 string to convert to Unicode. */ - size_t length, /* Length of UTF-8 string in bytes, or -1 for + Tcl_Size length, /* Length of UTF-8 string in bytes, or -1 for * strlen(). */ Tcl_DString *dsPtr) /* Unicode representation of string is * appended to this previously initialized @@ -722,7 +743,7 @@ Tcl_UtfToChar16DString( { unsigned short ch = 0, *w, *wString; const char *p; - size_t oldLength; + Tcl_Size oldLength; /* Pointer to the end of string. Never read endPtr[0] */ const char *endPtr = src + length; /* Pointer to last byte where optimization still can be used */ @@ -731,7 +752,7 @@ Tcl_UtfToChar16DString( if (src == NULL) { return NULL; } - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = strlen(src); } @@ -792,7 +813,7 @@ int Tcl_UtfCharComplete( const char *src, /* String to check if first few bytes contain * a complete UTF-8 character. */ - size_t length) /* Length of above string in bytes. */ + Tcl_Size length) /* Length of above string in bytes. */ { return length >= complete[UCHAR(*src)]; } @@ -815,16 +836,16 @@ Tcl_UtfCharComplete( *--------------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_NumUtfChars( const char *src, /* The UTF-8 string to measure. */ - size_t length) /* The length of the string in bytes, or - * TCL_INDEX_NONE for strlen(src). */ + Tcl_Size length) /* The length of the string in bytes, or + * negative value for strlen(src). */ { Tcl_UniChar ch = 0; - size_t i = 0; + Tcl_Size i = 0; - if (length == TCL_INDEX_NONE) { + if (length < 0) { /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ while (*src != '\0') { src += TclUtfToUniChar(src, &ch); @@ -867,16 +888,16 @@ Tcl_NumUtfChars( return i; } -size_t +Tcl_Size TclNumUtfChars( const char *src, /* The UTF-8 string to measure. */ - size_t length) /* The length of the string in bytes, or - * TCL_INDEX_NONE for strlen(src). */ + Tcl_Size length) /* The length of the string in bytes, or + * negative for strlen(src). */ { unsigned short ch = 0; - size_t i = 0; + Tcl_Size i = 0; - if (length == TCL_INDEX_NONE) { + if (length < 0) { /* string is NUL-terminated, so TclUtfToUniChar calls are safe. */ while (*src != '\0') { src += Tcl_UtfToChar16(src, &ch); @@ -1194,12 +1215,12 @@ Tcl_UtfPrev( int Tcl_UniCharAtIndex( const char *src, /* The UTF-8 string to dereference. */ - size_t index) /* The position of the desired character. */ + Tcl_Size index) /* The position of the desired character. */ { Tcl_UniChar ch = 0; int i = 0; - if (index == TCL_INDEX_NONE) { + if (index < 0) { return -1; } while (index--) { @@ -1238,11 +1259,11 @@ Tcl_UniCharAtIndex( const char * Tcl_UtfAtIndex( const char *src, /* The UTF-8 string. */ - size_t index) /* The position of the desired character. */ + Tcl_Size index) /* The position of the desired character. */ { int ch = 0; - if (index != TCL_INDEX_NONE) { + if (index > 0) { while (index--) { /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */ src += Tcl_UtfToUniChar(src, &ch); @@ -1254,12 +1275,12 @@ Tcl_UtfAtIndex( const char * TclUtfAtIndex( const char *src, /* The UTF-8 string. */ - size_t index) /* The position of the desired character. */ + Tcl_Size index) /* The position of the desired character. */ { unsigned short ch = 0; - size_t len = 0; + Tcl_Size len = 0; - if (index != TCL_INDEX_NONE) { + if (index > 0) { while (index--) { src += (len = Tcl_UtfToChar16(src, &ch)); } @@ -1297,7 +1318,7 @@ TclUtfAtIndex( *--------------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_UtfBackslash( const char *src, /* Points to the backslash character of a * backslash sequence. */ @@ -1307,7 +1328,8 @@ Tcl_UtfBackslash( * backslash sequence. */ { #define LINE_LENGTH 128 - size_t numRead, result; + Tcl_Size numRead; + int result; result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); if (numRead == LINE_LENGTH) { @@ -1341,13 +1363,13 @@ Tcl_UtfBackslash( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_UtfToUpper( char *str) /* String to convert in place. */ { int ch, upChar; char *src, *dst; - size_t len; + Tcl_Size len; /* * Iterate over the string until we hit the terminating null. @@ -1394,13 +1416,13 @@ Tcl_UtfToUpper( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_UtfToLower( char *str) /* String to convert in place. */ { int ch, lowChar; char *src, *dst; - size_t len; + Tcl_Size len; /* * Iterate over the string until we hit the terminating null. @@ -1448,13 +1470,13 @@ Tcl_UtfToLower( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_UtfToTitle( char *str) /* String to convert in place. */ { int ch, titleChar, lowChar; char *src, *dst; - size_t len; + Tcl_Size len; /* * Capitalize the first character and then lowercase the rest of the @@ -1870,11 +1892,11 @@ Tcl_UniCharToTitle( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_Char16Len( const unsigned short *uniStr) /* Unicode string to find length of. */ { - size_t len = 0; + Tcl_Size len = 0; while (*uniStr != '\0') { len++; @@ -1901,11 +1923,11 @@ Tcl_Char16Len( */ #undef Tcl_UniCharLen -size_t +Tcl_Size Tcl_UniCharLen( const int *uniStr) /* Unicode string to find length of. */ { - size_t len = 0; + Tcl_Size len = 0; while (*uniStr != '\0') { len++; @@ -1988,7 +2010,7 @@ int TclUniCharNcasecmp( const Tcl_UniChar *ucs, /* Unicode string to compare to uct. */ const Tcl_UniChar *uct, /* Unicode string ucs is compared to. */ - size_t numChars) /* Number of unichars to compare. */ + size_t numChars) /* Number of Unichars to compare. */ { for ( ; numChars != 0; numChars--, ucs++, uct++) { if (*ucs != *uct) { @@ -2563,10 +2585,10 @@ TclUniCharCaseMatch( int TclUniCharMatch( const Tcl_UniChar *string, /* Unicode String. */ - size_t strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const Tcl_UniChar *pattern, /* Pattern, which may contain special * characters. */ - size_t ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ int nocase) /* 0 for case sensitive, 1 for insensitive */ { const Tcl_UniChar *stringEnd, *patternEnd; diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0ebfb1dce46d..07b497b32da0 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -12,6 +12,7 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#include #include "tclInt.h" #include "tclParse.h" #include "tclStringTrim.h" @@ -102,14 +103,14 @@ static void ClearHash(Tcl_HashTable *tablePtr); static void FreeProcessGlobalValue(void *clientData); static void FreeThreadHash(void *clientData); static int GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t endValue, Tcl_WideInt *indexPtr); + Tcl_WideInt endValue, Tcl_WideInt *indexPtr); static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr); static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, - size_t endValue, Tcl_WideInt *widePtr); + Tcl_WideInt endValue, Tcl_WideInt *widePtr); static int FindElement(Tcl_Interp *interp, const char *string, - size_t stringLength, const char *typeStr, + Tcl_Size stringLength, const char *typeStr, const char *typeCode, const char **elementPtr, - const char **nextPtr, size_t *sizePtr, + const char **nextPtr, Tcl_Size *sizePtr, int *literalPtr); /* * The following is the Tcl object type definition for an object that @@ -133,7 +134,7 @@ static const TclObjTypeWithAbstractList endOffsetType = { )} }; -size_t +Tcl_Size TclLengthOne( TCL_UNUSED(Tcl_Obj *)) { @@ -394,13 +395,13 @@ TclLengthOne( *---------------------------------------------------------------------- */ -int +Tcl_Size TclMaxListLength( const char *bytes, - size_t numBytes, + Tcl_Size numBytes, const char **endPtr) { - size_t count = 0; + Tcl_Size count = 0; if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) { /* Empty string case - quick exit */ @@ -503,13 +504,13 @@ TclFindElement( const char *list, /* Points to the first byte of a string * containing a Tcl list with zero or more * elements (possibly in braces). */ - size_t listLength, /* Number of bytes in the list's string. */ + Tcl_Size listLength, /* Number of bytes in the list's string. */ const char **elementPtr, /* Where to put address of first significant * character in first element of list. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list). */ - size_t *sizePtr, /* If non-zero, fill in with size of + Tcl_Size *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -531,14 +532,14 @@ TclFindDictElement( * containing a Tcl dictionary with zero or * more keys and values (possibly in * braces). */ - size_t dictLength, /* Number of bytes in the dict's string. */ + Tcl_Size dictLength, /* Number of bytes in the dict's string. */ const char **elementPtr, /* Where to put address of first significant * character in the first element (i.e., key * or value) of dict. */ const char **nextPtr, /* Fill in with location of character just * after all white space following end of * element (next arg or end of list). */ - size_t *sizePtr, /* If non-zero, fill in with size of + Tcl_Size *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -560,7 +561,7 @@ FindElement( * containing a Tcl list or dictionary with * zero or more elements (possibly in * braces). */ - size_t stringLength, /* Number of bytes in the string. */ + Tcl_Size stringLength, /* Number of bytes in the string. */ const char *typeStr, /* The name of the type of thing we are * parsing, for error messages. */ const char *typeCode, /* The type code for thing we are parsing, for @@ -570,7 +571,7 @@ FindElement( const char **nextPtr, /* Fill in with location of character just * after all white space following end of * argument (next arg or end of list/dict). */ - size_t *sizePtr, /* If non-zero, fill in with size of + Tcl_Size *sizePtr, /* If non-zero, fill in with size of * element. */ int *literalPtr) /* If non-zero, fill in with non-zero/zero to * indicate that the substring of *sizePtr @@ -582,10 +583,10 @@ FindElement( const char *p = string; const char *elemStart; /* Points to first byte of first element. */ const char *limit; /* Points just after list/dict's last byte. */ - size_t openBraces = 0; /* Brace nesting level during parse. */ + Tcl_Size openBraces = 0; /* Brace nesting level during parse. */ int inQuotes = 0; - size_t size = 0; - size_t numChars; + Tcl_Size size = 0; + Tcl_Size numChars; int literal = 1; const char *p2; @@ -793,21 +794,21 @@ FindElement( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclCopyAndCollapse( - size_t count, /* Number of byte to copy from src. */ + Tcl_Size count, /* Number of byte to copy from src. */ const char *src, /* Copy from here... */ char *dst) /* ... to here. */ { - size_t newCount = 0; + Tcl_Size newCount = 0; while (count > 0) { char c = *src; if (c == '\\') { char buf[4] = ""; - size_t numRead; - size_t backslashCount = TclParseBackslash(src, count, &numRead, buf); + Tcl_Size numRead; + Tcl_Size backslashCount = TclParseBackslash(src, count, &numRead, buf); memcpy(dst, buf, backslashCount); dst += backslashCount; @@ -860,7 +861,7 @@ Tcl_SplitList( Tcl_Interp *interp, /* Interpreter to use for error reporting. If * NULL, no error message is left. */ const char *list, /* Pointer to string with list structure. */ - size_t *argcPtr, /* Pointer to location to fill in with the + Tcl_Size *argcPtr, /* Pointer to location to fill in with the * number of elements in the list. */ const char ***argvPtr) /* Pointer to place to store pointer to array * of pointers to list elements. */ @@ -868,7 +869,7 @@ Tcl_SplitList( const char **argv, *end, *element; char *p; int result; - size_t length, size, i, elSize; + Tcl_Size length, size, i, elSize; /* * Allocate enough space to work in. A (const char *) for each (possible) @@ -901,7 +902,7 @@ Tcl_SplitList( Tcl_Free((void *)argv); if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "internal error in Tcl_SplitList", TCL_INDEX_NONE)); + "internal error in Tcl_SplitList", -1)); Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList", NULL); } @@ -945,7 +946,7 @@ Tcl_SplitList( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_ScanElement( const char *src, /* String to convert to list element. */ int *flagPtr) /* Where to store information to guide @@ -977,15 +978,15 @@ Tcl_ScanElement( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_ScanCountedElement( const char *src, /* String to convert to Tcl list element. */ - size_t length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ int *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { char flags = CONVERT_ANY; - size_t numBytes = TclScanElement(src, length, &flags); + Tcl_Size numBytes = TclScanElement(src, length, &flags); *flagPtr = flags; return numBytes; @@ -1021,15 +1022,15 @@ Tcl_ScanCountedElement( *---------------------------------------------------------------------- */ -TCL_HASH_TYPE +Tcl_Size TclScanElement( const char *src, /* String to convert to Tcl list element. */ - size_t length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *flagPtr) /* Where to store information to guide * Tcl_ConvertElement. */ { const char *p = src; - size_t nestingLevel = 0; /* Brace nesting count */ + Tcl_Size nestingLevel = 0; /* Brace nesting count */ int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something * needs protection or escape. */ int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some @@ -1143,13 +1144,13 @@ TclScanElement( */ requireEscape = 1; - length -= (length+1 > 1); + length -= (length > 0); p++; break; } if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) { extra++; /* Escape sequences all one byte longer. */ - length -= (length+1 > 1); + length -= (length > 0); p++; } forbidNone = 1; @@ -1174,7 +1175,7 @@ TclScanElement( break; } } - length -= (length+1 > 1); + length -= (length > 0); p++; } @@ -1238,7 +1239,7 @@ TclScanElement( * If we are quoting solely due to ] or internal " characters use * the CONVERT_MASK mode where we escape all special characters * except for braces. "extra" counted space needed to escape - * braces too, so substract "braceCount" to get our actual needs. + * braces too, so subtract "braceCount" to get our actual needs. */ bytesNeeded += (extra - braceCount); @@ -1322,7 +1323,7 @@ TclScanElement( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_ConvertElement( const char *src, /* Source information for list element. */ char *dst, /* Place to put list-ified element. */ @@ -1352,14 +1353,14 @@ Tcl_ConvertElement( *---------------------------------------------------------------------- */ -size_t +Tcl_Size Tcl_ConvertCountedElement( const char *src, /* Source information for list element. */ - size_t length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { - size_t numBytes = TclConvertElement(src, length, dst, flags); + Tcl_Size numBytes = TclConvertElement(src, length, dst, flags); dst[numBytes] = '\0'; return numBytes; } @@ -1385,10 +1386,10 @@ Tcl_ConvertCountedElement( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclConvertElement( const char *src, /* Source information for list element. */ - size_t length, /* Number of bytes in src, or TCL_INDEX_NONE. */ + Tcl_Size length, /* Number of bytes in src, or TCL_INDEX_NONE. */ char *dst, /* Place to put list-ified element. */ int flags) /* Flags produced by Tcl_ScanElement. */ { @@ -1423,7 +1424,7 @@ TclConvertElement( p[1] = '#'; p += 2; src++; - length -= (length+1 > 1); + length -= (length > 0); } else { conversion = CONVERT_BRACE; } @@ -1464,7 +1465,7 @@ TclConvertElement( } *p = '}'; p++; - return (size_t)(p - dst); + return (p - dst); } /* conversion == CONVERT_ESCAPE or CONVERT_MASK */ @@ -1473,7 +1474,7 @@ TclConvertElement( * Formatted string is original string converted to escape sequences. */ - for ( ; length; src++, length -= (length+1 > 1)) { + for ( ; length; src++, length -= (length > 0)) { switch (*src) { case ']': case '[': @@ -1527,7 +1528,7 @@ TclConvertElement( continue; case '\0': if (length == TCL_INDEX_NONE) { - return (size_t)(p - dst); + return (p - dst); } /* @@ -1543,7 +1544,7 @@ TclConvertElement( *p = *src; p++; } - return (size_t)(p - dst); + return (p - dst); } /* @@ -1568,12 +1569,12 @@ TclConvertElement( char * Tcl_Merge( - size_t argc, /* How many strings to merge. */ + Tcl_Size argc, /* How many strings to merge. */ const char *const *argv) /* Array of string values. */ { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; - size_t i, bytesNeeded = 0; + Tcl_Size i, bytesNeeded = 0; char *result, *dst; /* @@ -1581,7 +1582,7 @@ Tcl_Merge( * simpler. */ - if (argc == 0) { + if (argc <= 0) { result = (char *)Tcl_Alloc(1); result[0] = '\0'; return result; @@ -1639,14 +1640,14 @@ Tcl_Merge( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclTrimRight( const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ + Tcl_Size numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - size_t numTrim) /* ...and its length in bytes */ + Tcl_Size numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { @@ -1664,7 +1665,7 @@ TclTrimRight( do { const char *q = trim; - size_t pInc = 0, bytesLeft = numTrim; + Tcl_Size pInc = 0, bytesLeft = numTrim; pp = Tcl_UtfPrev(p, bytes); do { @@ -1718,14 +1719,14 @@ TclTrimRight( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclTrimLeft( const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ + Tcl_Size numBytes, /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - size_t numTrim) /* ...and its length in bytes */ + Tcl_Size numTrim) /* ...and its length in bytes */ /* Calls to TclUtfToUniChar() in this routine * rely on (trim[numTrim] == '\0'). */ { @@ -1742,16 +1743,16 @@ TclTrimLeft( */ do { - size_t pInc = TclUtfToUCS4(p, &ch1); + Tcl_Size pInc = TclUtfToUCS4(p, &ch1); const char *q = trim; - size_t bytesLeft = numTrim; + Tcl_Size bytesLeft = numTrim; /* * Inner loop: scan trim string for match to current character. */ do { - size_t qInc = TclUtfToUCS4(q, &ch2); + Tcl_Size qInc = TclUtfToUCS4(q, &ch2); if (ch1 == ch2) { break; @@ -1792,19 +1793,19 @@ TclTrimLeft( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclTrim( const char *bytes, /* String to be trimmed... */ - size_t numBytes, /* ...and its length in bytes */ + Tcl_Size numBytes, /* ...and its length in bytes */ /* Calls in this routine * rely on (bytes[numBytes] == '\0'). */ const char *trim, /* String of trim characters... */ - size_t numTrim, /* ...and its length in bytes */ + Tcl_Size numTrim, /* ...and its length in bytes */ /* Calls in this routine * rely on (trim[numTrim] == '\0'). */ - size_t *trimRightPtr) /* Offset from the end of the string. */ + Tcl_Size *trimRightPtr) /* Offset from the end of the string. */ { - size_t trimLeft = 0, trimRight = 0; + Tcl_Size trimLeft = 0, trimRight = 0; /* Empty strings -> nothing to do */ if ((numBytes > 0) && (numTrim > 0)) { @@ -1856,10 +1857,10 @@ TclTrim( char * Tcl_Concat( - size_t argc, /* Number of strings to concatenate. */ + Tcl_Size argc, /* Number of strings to concatenate. */ const char *const *argv) /* Array of strings to concatenate. */ { - size_t i, needSpace = 0, bytesNeeded = 0; + Tcl_Size i, needSpace = 0, bytesNeeded = 0; char *result, *p; /* @@ -1878,16 +1879,27 @@ Tcl_Concat( for (i = 0; i < argc; i++) { bytesNeeded += strlen(argv[i]); + if (bytesNeeded < 0) { + Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); + } } /* * All element bytes + (argc - 1) spaces + 1 terminating NULL. */ + if (bytesNeeded + argc - 1 < 0) { + /* + * Panic test could be tighter, but not going to bother for this + * legacy routine. + */ + + Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded"); + } result = (char *)Tcl_Alloc(bytesNeeded + argc); for (p = result, i = 0; i < argc; i++) { - size_t triml, trimr, elemLength; + Tcl_Size triml, trimr, elemLength; const char *element; element = argv[i]; @@ -1945,11 +1957,11 @@ Tcl_Concat( Tcl_Obj * Tcl_ConcatObj( - size_t objc, /* Number of objects to concatenate. */ + Tcl_Size objc, /* Number of objects to concatenate. */ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */ { int needSpace = 0; - size_t i, bytesNeeded = 0, elemLength; + Tcl_Size i, bytesNeeded = 0, elemLength; const char *element; Tcl_Obj *objPtr, *resPtr; @@ -1960,7 +1972,7 @@ Tcl_ConcatObj( */ for (i = 0; i < objc; i++) { - size_t length; + Tcl_Size length; objPtr = objv[i]; if (TclListObjIsCanonical(objPtr)) { @@ -2006,11 +2018,14 @@ Tcl_ConcatObj( * Something cannot be determined to be safe, so build the concatenation * the slow way, using the string representations. * - * First try to pre-allocate the size required. + * First try to preallocate the size required. */ for (i = 0; i < objc; i++) { element = Tcl_GetStringFromObj(objv[i], &elemLength); + if (bytesNeeded > (TCL_SIZE_MAX - elemLength)) { + break; /* Overflow. Do not preallocate. See comment below. */ + } bytesNeeded += elemLength; } @@ -2025,7 +2040,7 @@ Tcl_ConcatObj( Tcl_SetObjLength(resPtr, 0); for (i = 0; i < objc; i++) { - size_t triml, trimr; + Tcl_Size triml, trimr; element = Tcl_GetStringFromObj(objv[i], &elemLength); @@ -2316,11 +2331,11 @@ Tcl_StringCaseMatch( int TclByteArrayMatch( const unsigned char *string,/* String. */ - size_t strLen, /* Length of String */ + Tcl_Size strLen, /* Length of String */ const unsigned char *pattern, /* Pattern, which may contain special * characters. */ - size_t ptnLen, /* Length of Pattern */ + Tcl_Size ptnLen, /* Length of Pattern */ TCL_UNUSED(int) /*flags*/) { const unsigned char *stringEnd, *patternEnd; @@ -2498,7 +2513,7 @@ TclStringMatchObj( * 0. */ { int match; - size_t length = 0, plen = 0; + Tcl_Size length = 0, plen = 0; /* * Promote based on the type of incoming object. @@ -2578,13 +2593,13 @@ Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is * TCL_INDEX_NONE then this must be null-terminated. */ - size_t length) /* Number of bytes from "bytes" to append. If + Tcl_Size length) /* Number of bytes from "bytes" to append. If * TCL_INDEX_NONE, then append all of bytes, up to null * at end. */ { - size_t newSize; + Tcl_Size newSize; - if (length == TCL_INDEX_NONE) { + if (length < 0) { length = strlen(bytes); } newSize = length + dsPtr->length; @@ -2603,7 +2618,7 @@ Tcl_DStringAppend( memcpy(newString, dsPtr->string, dsPtr->length); dsPtr->string = newString; } else { - size_t index = TCL_INDEX_NONE; + Tcl_Size index = TCL_INDEX_NONE; /* See [16896d49fd] */ if (bytes >= dsPtr->string @@ -2613,7 +2628,7 @@ Tcl_DStringAppend( dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl); - if (index != TCL_INDEX_NONE) { + if (index >= 0) { bytes = dsPtr->string + index; } } @@ -2645,7 +2660,7 @@ TclDStringAppendObj( Tcl_DString *dsPtr, Tcl_Obj *objPtr) { - size_t length; + Tcl_Size length; const char *bytes = Tcl_GetStringFromObj(objPtr, &length); return Tcl_DStringAppend(dsPtr, bytes, length); @@ -2688,7 +2703,7 @@ Tcl_DStringAppendElement( int needSpace = TclNeedSpace(dsPtr->string, dst); char flags = 0; int quoteHash = 1; - size_t newSize; + Tcl_Size newSize; if (needSpace) { /* @@ -2789,9 +2804,9 @@ Tcl_DStringAppendElement( void Tcl_DStringSetLength( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ - size_t length) /* New length for dynamic string. */ + Tcl_Size length) /* New length for dynamic string. */ { - size_t newsize; + Tcl_Size newsize; if (length >= dsPtr->spaceAvl) { /* @@ -3115,7 +3130,7 @@ Tcl_PrintDouble( } } - sprintf(dst, "e%+d", exponent); + snprintf(dst, TCL_DOUBLE_SPACE, "e%+d", exponent); } else { /* * F format for others. @@ -3268,14 +3283,14 @@ TclNeedSpace( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclFormatInt( char *buffer, /* Points to the storage into which the * formatted characters are written. */ Tcl_WideInt n) /* The integer to format. */ { Tcl_WideUInt intVal; - size_t i = 0, numFormatted, j; + int i = 0, numFormatted, j; static const char digits[] = "0123456789"; /* @@ -3338,7 +3353,7 @@ GetWideForIndex( * NULL, then no error message is left after * errors. */ Tcl_Obj *objPtr, /* Points to the value to be parsed */ - size_t endValue, /* The value to be stored at *widePtr if + Tcl_WideInt endValue, /* The value to be stored at *widePtr if * objPtr holds "end". * NOTE: this value may be TCL_INDEX_NONE. */ Tcl_WideInt *widePtr) /* Location filled in with a wide integer @@ -3375,11 +3390,18 @@ GetWideForIndex( * object. The string value 'objPtr' is expected have the format * integer([+-]integer)? or end([+-]integer)?. * - * Value + * If the computed index lies within the valid range of Tcl indices + * (0..TCL_SIZE_MAX) it is returned. Higher values are returned as + * TCL_SIZE_MAX. Negative values are returned as TCL_INDEX_NONE (-1). + * + * Callers should pass reasonable values for endValue - one in the + * valid index range or TCL_INDEX_NONE (-1), for example for an empty + * list. + * + * Results: * TCL_OK * - * The index is stored at the address given by by 'indexPtr'. If - * 'objPtr' has the value "end", the value stored is 'endValue'. + * The index is stored at the address given by by 'indexPtr'. * * TCL_ERROR * @@ -3387,10 +3409,9 @@ GetWideForIndex( * 'interp' is non-NULL, an error message is left in the interpreter's * result object. * - * Effect + * Side effects: * - * The object referenced by 'objPtr' is converted, as needed, to an - * integer, wide integer, or end-based-index object. + * The internal representation contained within objPtr may shimmer. * *---------------------------------------------------------------------- */ @@ -3402,9 +3423,8 @@ Tcl_GetIntForIndex( * errors. */ Tcl_Obj *objPtr, /* Points to an object containing either "end" * or an integer. */ - size_t endValue, /* The value to be stored at "indexPtr" if - * "objPtr" holds "end". */ - size_t *indexPtr) /* Location filled in with an integer + Tcl_Size endValue, /* The value corresponding to the "end" index */ + Tcl_Size *indexPtr) /* Location filled in with an integer * representing an index. May be NULL.*/ { Tcl_WideInt wide; @@ -3413,16 +3433,18 @@ Tcl_GetIntForIndex( return TCL_ERROR; } if (indexPtr != NULL) { - if ((wide < 0) && (endValue < TCL_INDEX_END)) { - *indexPtr = TCL_INDEX_NONE; - } else if ((Tcl_WideUInt)wide > TCL_INDEX_END && (endValue < TCL_INDEX_END)) { - *indexPtr = TCL_INDEX_END; + /* Note: check against TCL_SIZE_MAX needed for 32-bit builds */ + if (wide >= 0 && wide <= TCL_SIZE_MAX) { + *indexPtr = (Tcl_Size)wide; + } else if (wide > TCL_SIZE_MAX) { + *indexPtr = TCL_SIZE_MAX; } else { - *indexPtr = (size_t) wide; + *indexPtr = TCL_INDEX_NONE; } } return TCL_OK; } + /* *---------------------------------------------------------------------- * @@ -3439,7 +3461,8 @@ Tcl_GetIntForIndex( * -2: Index "end-1" * -1: Index "end" * 0: Index "0" - * WIDE_MAX-1: Index "end+n", for any n > 1 + * WIDE_MAX-1: Index "end+n", for any n > 1. Distinguish from end+1 for + * commands like lset. * WIDE_MAX: Index "end+1" * * Results: @@ -3455,7 +3478,7 @@ static int GetEndOffsetFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, /* Pointer to the object to parse */ - size_t endValue, /* The value to be stored at "indexPtr" if + Tcl_WideInt endValue, /* The value to be stored at "widePtr" if * "objPtr" holds "end". */ Tcl_WideInt *widePtr) /* Location filled in with an integer * representing an index. */ @@ -3466,7 +3489,7 @@ GetEndOffsetFromObj( while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType.objType)) == NULL) { Tcl_ObjInternalRep ir; - size_t length; + Tcl_Size length; const char *bytes = Tcl_GetStringFromObj(objPtr, &length); if (*bytes != 'e') { @@ -3656,15 +3679,26 @@ GetEndOffsetFromObj( offset = irPtr->wideValue; if (offset == WIDE_MAX) { + /* + * Encodes end+1. This is distinguished from end+n as noted above + * NOTE: this may wrap around if the caller passes (as lset does) + * listLen-1 as endValue and and listLen is 0. The -1 will be + * interpreted as FF...FF and adding 1 will result in 0 which + * is what we want. 2's complements shenanigans but it is what + * it is ... + */ *widePtr = endValue + 1; } else if (offset == WIDE_MIN) { + /* -1 - position before first */ *widePtr = -1; } else if (offset < 0) { - /* Different signs, sum cannot overflow */ + /* end-(n-1) - Different signs, sum cannot overflow */ *widePtr = endValue + offset + 1; } else if (offset < WIDE_MAX) { + /* 0:WIDE_MAX-1 - plain old index. */ *widePtr = offset; } else { + /* Huh, what case remains here? */ *widePtr = WIDE_MAX; } return TCL_OK; @@ -3689,19 +3723,26 @@ GetEndOffsetFromObj( *---------------------------------------------------------------------- * * TclIndexEncode -- + * IMPORTANT: function only encodes indices in the range that fits within + * an "int" type. Do NOT change this as the byte code compiler and engine + * which call this function cannot handle wider index types. Indices + * outside the range will result in the function returning an error. * * Parse objPtr to determine if it is an index value. Two cases * are possible. The value objPtr might be parsed as an absolute - * index value in the C signed int range. Note that this includes + * index value in the Tcl_Size range. Note that this includes * index values that are integers as presented and it includes index - * arithmetic expressions. The absolute index values that can be + * arithmetic expressions. + * + * The largest string supported in Tcl 8 has byte length TCL_SIZE_MAX. + * This means the largest supported character length is also TCL_SIZE_MAX, + * and the index of the last character in a string of length TCL_SIZE_MAX + * is TCL_SIZE_MAX-1. Thus the absolute index values that can be * directly meaningful as an index into either a list or a string are - * those integer values >= TCL_INDEX_START (0) - * and < INT_MAX. - * The largest string supported in Tcl 8 has bytelength INT_MAX. - * This means the largest supported character length is also INT_MAX, - * and the index of the last character in a string of length INT_MAX - * is INT_MAX-1. + * integer values in the range 0 to TCL_SIZE_MAX - 1. + * + * This function however can only handle integer indices in the range + * 0 : INT_MAX-1. * * Any absolute index value parsed outside that range is encoded * using the before and after values passed in by the @@ -3726,12 +3767,9 @@ GetEndOffsetFromObj( * if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed, * they can be encoded with the before value. * - * These details will require re-examination whenever string and - * list length limits are increased, but that will likely also - * mean a revised routine capable of returning Tcl_WideInt values. - * * Returns: - * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed or the + * index does not fit in an int type. * * Side effects: * When TCL_OK is returned, the encoded index value is written @@ -3744,51 +3782,138 @@ int TclIndexEncode( Tcl_Interp *interp, /* For error reporting, may be NULL */ Tcl_Obj *objPtr, /* Index value to parse */ - size_t before, /* Value to return for index before beginning */ - size_t after, /* Value to return for index after end */ + int before, /* Value to return for index before beginning */ + int after, /* Value to return for index after end */ int *indexPtr) /* Where to write the encoded answer, not NULL */ { Tcl_WideInt wide; int idx; + const Tcl_WideInt ENDVALUE = 2 * (Tcl_WideInt) INT_MAX; + + assert(ENDVALUE < WIDE_MAX); + if (TCL_OK != GetWideForIndex(interp, objPtr, ENDVALUE, &wide)) { + return TCL_ERROR; + } + /* + * We passed 2*INT_MAX as the "end value" to GetWideForIndex. The computed + * index will in one of the following ranges that need to be distinguished + * for encoding purposes in the following code. + * (1) 0:INT_MAX when + * (a) objPtr was a pure non-negative numeric value in that range + * (b) objPtr was a numeric computation M+/-N with a result in that range + * (c) objPtr was of the form end-N where N was in range INT_MAX:2*INT_MAX + * (2) INT_MAX+1:2*INT_MAX when + * (a,b) as above + * (c) objPtr was of the form end-N where N was in range 0:INT_MAX-1 + * (3) 2*INT_MAX:WIDE_MAX when + * (a,b) as above + * (c) objPtr was of the form end+N + * (4) (2*INT_MAX)-TCL_SIZE_MAX : -1 when + * (a,b) as above + * (c) objPtr was of the form end-N where N was in the range 0:TCL_SIZE_MAX + * (5) WIDE_MIN:(2*INT_MAX)-TCL_SIZE_MAX + * (a,b) as above + * (c) objPtr was of the form end-N where N was > TCL_SIZE_MAX + * + * For all cases (b) and (c), the internal representation of objPtr + * will be shimmered to endOffsetType. That allows us to distinguish between + * (for example) 1a (encodable) and 1c (not encodable) though the computed + * index value is the same. + * + * Further note, the values TCL_SIZE_MAX < N < WIDE_MAX come into play + * only in the 32-bit builds as TCL_SIZE_MAX == WIDE_MAX for 64-bits. + */ + + const Tcl_ObjInternalRep *irPtr = + TclFetchInternalRep(objPtr, &endOffsetType.objType); + + if (irPtr && irPtr->wideValue >= 0) { + /* + * "int[+-]int" syntax, works the same here as "int". + * Note same does not hold for negative integers. + * Distinguishes 1b and 1c where wide will be in 0:INT_MAX for + * both but irPtr->wideValue will be negative for 1c. + */ + irPtr = NULL; + } - if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) { - const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &endOffsetType.objType); - if (irPtr && irPtr->wideValue >= 0) { - /* "int[+-]int" syntax, works the same here as "int" */ - irPtr = NULL; + if (irPtr == NULL) { + /* objPtr can be treated as a purely numeric value. */ + + /* + * On 64-bit systems, indices in the range INT_MAX:TCL_SIZE_MAX are + * valid indices but are not in the encodable range. Thus an + * error is raised. On 32-bit systems, indices in that range indicate + * the position after the end and so do not raise an error. + */ + if ((sizeof(int) != sizeof(size_t)) && + (wide > INT_MAX) && (wide < WIDE_MAX-1)) { + /* 2(a,b) on 64-bit systems*/ + goto rangeerror; + } + if (wide > INT_MAX) { + /* + * 3(a,b) on 64-bit systems and 2(a,b), 3(a,b) on 32-bit systems + * Because of the check above, this case holds for indices + * greater than INT_MAX on 32-bit systems and > TCL_SIZE_MAX + * on 64-bit systems. Always maps to the element after the end. + */ + idx = after; + } else if (wide < 0) { + /* 4(a,b) (32-bit systems), 5(a,b) - before the beginning */ + idx = before; + } else { + /* 1(a,b) Encodable range */ + idx = (int)wide; } + } else { + /* objPtr is not purely numeric (end etc.) */ + /* - * We parsed an end+offset index value. - * wide holds the offset value in the range WIDE_MIN...WIDE_MAX. + * On 64-bit systems, indices in the range end-LIST_MAX:end-INT_MAX + * are valid indices (with max size strings/lists) but are not in + * the encodable range. Thus an error is raised. On 32-bit systems, + * indices in that range indicate the position before the beginning + * and so do not raise an error. */ - if ((irPtr ? ((wide < INT_MIN) && ((size_t)-wide <= LIST_MAX)) - : ((wide > INT_MAX) && ((size_t)wide <= LIST_MAX))) && (sizeof(int) != sizeof(size_t))) { - if (interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "index \"%s\" out of range", - TclGetString(objPtr))); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" - "OUTOFRANGE", NULL); - } - return TCL_ERROR; - } else if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) { + if ((sizeof(int) != sizeof(size_t)) && + (wide > (ENDVALUE - LIST_MAX)) && (wide <= INT_MAX)) { + /* 1(c), 4(a,b) on 64-bit systems */ + goto rangeerror; + } + if (wide > ENDVALUE) { /* - * All end+postive or end-negative expressions + * 2(c) (32-bit systems), 3(c) + * All end+positive or end-negative expressions * always indicate "after the end". + * Note we will not reach here for a pure numeric value in this + * range because irPtr will be NULL in that case. */ idx = after; - } else if (wide <= (irPtr ? INT_MAX : -1)) { - /* These indices always indicate "before the beginning */ + } else if (wide <= INT_MAX) { + /* 1(c) (32-bit systems), 4(c) (32-bit systems), 5(c) */ idx = before; } else { - /* Encoded end-positive (or end+negative) are offset */ + /* 2(c) Encodable end-positive (or end+negative) */ idx = (int)wide; } - } else { - return TCL_ERROR; } *indexPtr = idx; return TCL_OK; + +rangeerror: + if (interp) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("index \"%s\" out of range", TclGetString(objPtr))); + Tcl_SetErrorCode(interp, + "TCL", + "VALUE", + "INDEX" + "OUTOFRANGE", + NULL); + } + return TCL_ERROR; } /* @@ -3806,20 +3931,91 @@ TclIndexEncode( *---------------------------------------------------------------------- */ -size_t +Tcl_Size TclIndexDecode( int encoded, /* Value to decode */ - size_t endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ + Tcl_Size endValue) /* Meaning of "end" to use, > TCL_INDEX_END */ { - if (encoded > (int)TCL_INDEX_END) { + if (encoded > TCL_INDEX_END) { return encoded; } - if (endValue >= TCL_INDEX_END - encoded) { - return endValue + encoded - TCL_INDEX_END; + endValue += encoded - TCL_INDEX_END; + if (endValue >= 0) { + return endValue; } return TCL_INDEX_NONE; } +/* + *------------------------------------------------------------------------ + * + * TclIndexInvalidError -- + * + * Generates an error message including the invalid index. + * + * Results: + * Always return TCL_ERROR. + * + * Side effects: + * If interp is not-NULL, an error message is stored in it. + * + *------------------------------------------------------------------------ + */ +int +TclIndexInvalidError ( + Tcl_Interp *interp, /* May be NULL */ + const char *idxType, /* The descriptive string for idx. Defaults to "index" */ + Tcl_Size idx) /* Invalid index value */ +{ + if (interp) { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Invalid %s value %" TCL_SIZE_MODIFIER "d.", + idxType ? idxType : "index", + idx)); + } + return TCL_ERROR; /* Always */ +} + +/* + *------------------------------------------------------------------------ + * + * TclCommandWordLimitErrpr -- + * + * Generates an error message limit on number of command words exceeded. + * + * Results: + * Always return TCL_ERROR. + * + * Side effects: + * If interp is not-NULL, an error message is stored in it. + * + *------------------------------------------------------------------------ + */ +int +TclCommandWordLimitError ( + Tcl_Interp *interp, /* May be NULL */ + Tcl_Size count) /* If <= 0, "unknown" */ +{ + if (interp) { + if (count > 0) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("Number of words (%" TCL_SIZE_MODIFIER + "d) in command exceeds limit %" TCL_SIZE_MODIFIER + "d.", + count, + (Tcl_Size)INT_MAX)); + } + else { + Tcl_SetObjResult(interp, + Tcl_ObjPrintf("Number of words in command exceeds " + "limit %" TCL_SIZE_MODIFIER "d.", + (Tcl_Size)INT_MAX)); + } + } + return TCL_ERROR; /* Always */ +} + /* *---------------------------------------------------------------------- * @@ -4010,7 +4206,7 @@ TclGetProcessGlobalValue( Tcl_Obj *value = NULL; Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; - size_t epoch = pgvPtr->epoch; + Tcl_Size epoch = pgvPtr->epoch; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4217,7 +4413,7 @@ int TclReToGlob( Tcl_Interp *interp, const char *reStr, - size_t reStrLen, + Tcl_Size reStrLen, Tcl_DString *dsPtr, int *exactPtr, int *quantifiersFoundPtr) @@ -4410,7 +4606,7 @@ TclReToGlob( invalidGlob: if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1)); Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL); } Tcl_DStringFree(dsPtr); diff --git a/generic/tclVar.c b/generic/tclVar.c index bc94e738a1a9..550d7a6a444a 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -263,7 +263,7 @@ static const Tcl_ObjType localVarNameType = { const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &localVarNameType); \ (name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL; \ - (index) = irPtr ? PTR2UINT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ + (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : TCL_INDEX_NONE; \ } while (0) static const Tcl_ObjType parsedVarNameType = { @@ -301,7 +301,7 @@ TclVarHashCreateVar( Tcl_Obj *keyPtr; Var *varPtr; - keyPtr = Tcl_NewStringObj(key, TCL_INDEX_NONE); + keyPtr = Tcl_NewStringObj(key, -1); Tcl_IncrRefCount(keyPtr); varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr); Tcl_DecrRefCount(keyPtr); @@ -469,7 +469,7 @@ TclLookupVar( * is set to NULL. */ { Var *varPtr; - Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, TCL_INDEX_NONE); + Tcl_Obj *part1Ptr = Tcl_NewStringObj(part1, -1); if (createPart1) { Tcl_IncrRefCount(part1Ptr); @@ -551,7 +551,7 @@ TclObjLookupVar( Var *resPtr; if (part2) { - part2Ptr = Tcl_NewStringObj(part2, TCL_INDEX_NONE); + part2Ptr = Tcl_NewStringObj(part2, -1); if (createPart2) { Tcl_IncrRefCount(part2Ptr); } @@ -604,14 +604,14 @@ TclObjLookupVarEx( const char *errMsg = NULL; int index, parsed = 0; - size_t localIndex; + Tcl_Size localIndex; Tcl_Obj *namePtr, *arrayPtr, *elem; *arrayPtrPtr = NULL; restart: LocalGetInternalRep(part1Ptr, localIndex, namePtr); - if (localIndex != TCL_INDEX_NONE) { + if (localIndex >= 0) { if (HasLocalVars(varFramePtr) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { @@ -631,7 +631,7 @@ TclObjLookupVarEx( } /* - * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts. + * If part1Ptr is a parsedVarNameType, retrieve the preparsed parts. */ ParsedGetInternalRep(part1Ptr, parsed, arrayPtr, elem); @@ -659,7 +659,7 @@ TclObjLookupVarEx( * part1Ptr is possibly an unparsed array element. */ - size_t len; + Tcl_Size len; const char *part1 = Tcl_GetStringFromObj(part1Ptr, &len); if ((len > 1) && (part1[len - 1] == ')')) { @@ -792,7 +792,7 @@ TclObjLookupVarEx( * TclObjLookupVar): * -1 a global reference * -2 a reference to a namespace variable - * -3 a non-cachable reference, i.e., one of: + * -3 a non-cacheable reference, i.e., one of: * . non-indexed local var * . a reference of unknown origin; * . resolution by a namespace or interp resolver @@ -842,7 +842,7 @@ TclLookupSimpleVar( Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr; ResolverScheme *resPtr; int isNew, i, result; - size_t varLen; + Tcl_Size varLen; const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen); varPtr = NULL; @@ -949,7 +949,7 @@ TclLookupSimpleVar( return NULL; } if (tail != varName) { - tailPtr = Tcl_NewStringObj(tail, TCL_INDEX_NONE); + tailPtr = Tcl_NewStringObj(tail, -1); } else { tailPtr = varNamePtr; } @@ -972,7 +972,7 @@ TclLookupSimpleVar( if (localCt > 0) { Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0; const char *localNameStr; - size_t localLen; + Tcl_Size localLen; for (i=0 ; iflags |= TCL_LEAVE_ERR_MSG; result = done; @@ -3634,7 +3634,7 @@ ArrayGetCmd( Tcl_Obj **nameObjPtr, *patternObj; Tcl_HashSearch search; const char *pattern; - size_t i, count; + Tcl_Size i, count; int result, isArray; switch (objc) { @@ -3960,7 +3960,6 @@ ArraySetCmd( Tcl_Obj *arrayElemObj; Var *varPtr, *arrayPtr; int result; - size_t i; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "arrayName list"); @@ -3995,7 +3994,7 @@ ArraySetCmd( Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done; - size_t size; + Tcl_Size size; if (Tcl_DictObjSize(interp, arrayElemObj, &size) != TCL_OK) { return TCL_ERROR; @@ -4039,8 +4038,9 @@ ArraySetCmd( * -compatibility reasons) a list. */ - size_t elemLen; + Tcl_Size elemLen; Tcl_Obj **elemPtrs, *copyListObj; + Tcl_Size i; result = TclListObjLengthM(interp, arrayElemObj, &elemLen); if (result != TCL_OK) { @@ -4048,7 +4048,7 @@ ArraySetCmd( } if (elemLen & 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "list must have an even number of elements", TCL_INDEX_NONE)); + "list must have an even number of elements", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL); return TCL_ERROR; } @@ -4218,10 +4218,10 @@ ArrayStatsCmd( stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr); if (stats == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "error reading array statistics", TCL_INDEX_NONE)); + "error reading array statistics", -1)); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1)); Tcl_Free(stats); return TCL_OK; } @@ -4785,7 +4785,7 @@ Tcl_GetVariableFullName( Tcl_AppendObjToObj(objPtr, namePtr); } } else if (iPtr->varFramePtr->procPtr) { - size_t index = varPtr - iPtr->varFramePtr->compiledLocals; + Tcl_Size index = varPtr - iPtr->varFramePtr->compiledLocals; if (index < iPtr->varFramePtr->numCompiledLocals) { namePtr = localName(iPtr->varFramePtr, index); @@ -5609,7 +5609,7 @@ static void FreeLocalVarName( Tcl_Obj *objPtr) { - size_t index; + Tcl_Size index; Tcl_Obj *namePtr; LocalGetInternalRep(objPtr, index, namePtr); @@ -5625,7 +5625,7 @@ DupLocalVarName( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - size_t index; + Tcl_Size index; Tcl_Obj *namePtr; LocalGetInternalRep(srcPtr, index, namePtr); @@ -6209,7 +6209,7 @@ AppendLocals( { Interp *iPtr = (Interp *) interp; Var *varPtr; - size_t i, localVarCt; + Tcl_Size i, localVarCt; int added; Tcl_Obj *objNamePtr; const char *varName; diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 1653dbe4d868..48e741534135 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -42,14 +42,14 @@ #define ZIPFS_ERROR(interp,errstr) \ do { \ if (interp) { \ - Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, TCL_INDEX_NONE)); \ + Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \ } \ } while (0) #define ZIPFS_MEM_ERROR(interp) \ do { \ if (interp) { \ Tcl_SetObjResult(interp, Tcl_NewStringObj( \ - "out of memory", TCL_INDEX_NONE)); \ + "out of memory", -1)); \ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL); \ } \ } while (0) @@ -1382,7 +1382,7 @@ ZipFSOpenArchive( */ zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if (zf->length == TCL_INDEX_NONE) { + if (zf->length == (size_t) TCL_INDEX_NONE) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } @@ -1481,7 +1481,7 @@ ZipMapArchive( */ zf->length = lseek(fd, 0, SEEK_END); - if (zf->length == TCL_INDEX_NONE || zf->length < ZIP_CENTRAL_END_LEN) { + if (zf->length == (size_t) TCL_INDEX_NONE || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); return TCL_ERROR; } @@ -1708,8 +1708,8 @@ ZipFSCatalogFilesystem( Tcl_DString ds2; Tcl_DStringInit(&ds2); - Tcl_DStringAppend(&ds2, "assets/.root/", TCL_INDEX_NONE); - Tcl_DStringAppend(&ds2, path, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds2, "assets/.root/", -1); + Tcl_DStringAppend(&ds2, path, -1); if (ZipFSLookup(Tcl_DStringValue(&ds2))) { /* should not happen but skip it anyway */ Tcl_DStringFree(&ds2); @@ -1785,7 +1785,7 @@ ZipFSCatalogFilesystem( Tcl_DStringSetLength(&ds, strlen(z->name) + 8); Tcl_DStringSetLength(&ds, 0); - Tcl_DStringAppend(&ds, z->name, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, z->name, -1); dir = Tcl_DStringValue(&ds); for (endPtr = strrchr(dir, '/'); endPtr && (endPtr != dir); endPtr = strrchr(dir, '/')) { @@ -1907,9 +1907,9 @@ ListMountPoints( hPtr = Tcl_NextHashEntry(&search)) { zf = (ZipFile *) Tcl_GetHashValue(hPtr); Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj( - zf->mountPoint, TCL_INDEX_NONE)); + zf->mountPoint, -1)); Tcl_ListObjAppendElement(NULL, resultList, Tcl_NewStringObj( - zf->name, TCL_INDEX_NONE)); + zf->name, -1)); } Tcl_SetObjResult(interp, resultList); return TCL_OK; @@ -1943,7 +1943,7 @@ DescribeMounted( ZipFile *zf = ZipFSLookupZip(mountPoint); if (zf) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1)); return TCL_OK; } } @@ -2237,7 +2237,7 @@ ZipFSMountObjCmd( zipFileObj = Tcl_FSGetNormalizedPath(interp, objv[2]); if (!zipFileObj) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "could not normalize zip filename", TCL_INDEX_NONE)); + "could not normalize zip filename", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NORMALIZE", NULL); return TCL_ERROR; } @@ -2280,7 +2280,7 @@ ZipFSMountBufferObjCmd( { const char *mountPoint; /* Mount point path. */ unsigned char *data; - size_t length; + Tcl_Size length; if (objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?"); @@ -2333,7 +2333,7 @@ ZipFSRootObjCmd( TCL_UNUSED(int) /*objc*/, TCL_UNUSED(Tcl_Obj *const *)) /*objv*/ { - Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1)); return TCL_OK; } @@ -2391,7 +2391,7 @@ ZipFSMkKeyObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - size_t len, i = 0; + Tcl_Size len, i = 0; const char *pw; Tcl_Obj *passObj; unsigned char *passBuf; @@ -2409,7 +2409,7 @@ ZipFSMkKeyObjCmd( } passObj = Tcl_NewByteArrayObj(NULL, 264); - passBuf = Tcl_GetByteArrayFromObj(passObj, (size_t *)NULL); + passBuf = Tcl_GetByteArrayFromObj(passObj, (Tcl_Size *)NULL); while (len > 0) { int ch = pw[len - 1]; @@ -2516,7 +2516,8 @@ ZipAddFile( * UTF-8). */ const char *zpathTcl; /* Filename in Tcl's internal encoding. */ int crc, flush, zpathlen; - size_t nbyte, nbytecompr, len, olen, align = 0; + size_t nbyte, nbytecompr; + Tcl_Size len, olen, align = 0; long long headerStartOffset, dataStartOffset, dataEndOffset; int mtime = 0, isNew, compMeth; unsigned long keys[3], keys0[3]; @@ -2540,7 +2541,7 @@ ZipAddFile( * crazy enough to embed NULs in filenames, they deserve what they get! */ - zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, TCL_INDEX_NONE, &zpathDs); + zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs); zpathlen = strlen(zpathExt); if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -2578,7 +2579,7 @@ ZipAddFile( nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == TCL_INDEX_NONE) { + if (len < 0) { Tcl_DStringFree(&zpathDs); if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); @@ -2619,7 +2620,7 @@ ZipAddFile( memset(buf, '\0', ZIP_LOCAL_HEADER_LEN); memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpathExt, zpathlen); len = zpathlen + ZIP_LOCAL_HEADER_LEN; - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { writeErrorWithChannelOpen: Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error on \"%s\": %s", @@ -2643,7 +2644,7 @@ ZipAddFile( ZipWriteShort(astart, aend, abuf, 0xffff); ZipWriteShort(astart, aend, abuf + 2, align - 4); ZipWriteInt(astart, aend, abuf + 4, 0x03020100); - if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) { + if (Tcl_Write(out, (const char *) abuf, align) != align) { goto writeErrorWithChannelOpen; } } @@ -2708,7 +2709,7 @@ ZipAddFile( do { len = Tcl_Read(in, buf, bufsize); - if (len == TCL_INDEX_NONE) { + if (len < 0) { deflateEnd(&stream); goto readErrorWithChannelOpen; } @@ -2719,7 +2720,7 @@ ZipAddFile( stream.avail_out = sizeof(obuf); stream.next_out = (unsigned char *) obuf; len = deflate(&stream, flush); - if (len == (size_t) Z_STREAM_ERROR) { + if (len == Z_STREAM_ERROR) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "deflate error on \"%s\"", TclGetString(pathObj))); ZIPFS_ERROR_CODE(interp, "DEFLATE"); @@ -2730,14 +2731,14 @@ ZipAddFile( } olen = sizeof(obuf) - stream.avail_out; if (passwd) { - size_t i; + Tcl_Size i; int tmp; for (i = 0; i < olen; i++) { obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp); } } - if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) { + if (olen && (Tcl_Write(out, obuf, olen) != olen)) { deflateEnd(&stream); goto writeErrorWithChannelOpen; } @@ -2772,20 +2773,20 @@ ZipAddFile( nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == TCL_INDEX_NONE) { + if (len < 0) { goto readErrorWithChannelOpen; } else if (len == 0) { break; } if (passwd) { - size_t i; + Tcl_Size i; int tmp; for (i = 0; i < len; i++) { buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp); } } - if ((size_t) Tcl_Write(out, buf, len) != len) { + if (Tcl_Write(out, buf, len) != len) { goto writeErrorWithChannelOpen; } nbytecompr += len; @@ -2880,7 +2881,7 @@ ZipFSFind( Tcl_Obj *cmd[2]; int result; - cmd[0] = Tcl_NewStringObj("::tcl::zipfs::find", TCL_INDEX_NONE); + cmd[0] = Tcl_NewStringObj("::tcl::zipfs::find", -1); cmd[1] = dirRoot; Tcl_IncrRefCount(cmd[0]); result = Tcl_EvalObjv(interp, 2, cmd, 0); @@ -2918,11 +2919,11 @@ ComputeNameInArchive( * archive */ const char *strip, /* A prefix to strip; may be NULL if no * stripping need be done. */ - size_t slen) /* The length of the prefix; must be 0 if no + Tcl_Size slen) /* The length of the prefix; must be 0 if no * stripping need be done. */ { const char *name; - size_t len; + Tcl_Size len; if (directNameObj) { name = TclGetString(directNameObj); @@ -2991,10 +2992,11 @@ ZipFSMkZipOrImg( { Tcl_Channel out; int count, ret = TCL_ERROR; - size_t pwlen = 0, slen = 0, lobjc, len, i = 0; + Tcl_Size pwlen = 0, slen = 0, len, i = 0; + Tcl_Size lobjc; long long directoryStartOffset; - /* The overall file offset of the start of the - * central directory. */ + /* The overall file offset of the start of the + * central directory. */ long long suffixStartOffset;/* The overall file offset of the start of the * suffix of the central directory (i.e., * where this data will be written). */ @@ -3177,7 +3179,7 @@ ZipFSMkZipOrImg( strip = NULL; } } - for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { + for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) { Tcl_Obj *pathObj = lobjv[i]; const char *name = ComputeNameInArchive(pathObj, (mappingList ? lobjv[i + 1] : NULL), strip, slen); @@ -3197,7 +3199,7 @@ ZipFSMkZipOrImg( directoryStartOffset = Tcl_Tell(out); count = 0; - for (i = 0; i < (size_t) lobjc; i += (mappingList ? 2 : 1)) { + for (i = 0; i < lobjc; i += (mappingList ? 2 : 1)) { const char *name = ComputeNameInArchive(lobjv[i], (mappingList ? lobjv[i + 1] : NULL), strip, slen); Tcl_DString ds; @@ -3214,7 +3216,7 @@ ZipFSMkZipOrImg( z, len); if ((Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN) - || ((size_t) Tcl_Write(out, name, len) != len)) { + || (Tcl_Write(out, name, len) != len)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "write error: %s", Tcl_PosixError(interp))); Tcl_DStringFree(&ds); @@ -3281,8 +3283,8 @@ CopyImageFile( Tcl_Channel out) /* Where to copy to; already open for writing * binary data. */ { - size_t i, k; - int m, n; + Tcl_WideInt i, k; + Tcl_Size m, n; Tcl_Channel in; char buf[4096]; const char *errMsg; @@ -3298,7 +3300,7 @@ CopyImageFile( */ i = Tcl_Seek(in, 0, SEEK_END); - if (i == TCL_INDEX_NONE) { + if (i == -1) { errMsg = "seek error"; goto copyError; } @@ -3311,8 +3313,8 @@ CopyImageFile( for (k = 0; k < i; k += m) { m = i - k; - if (m > (int) sizeof(buf)) { - m = (int) sizeof(buf); + if (m > (Tcl_Size) sizeof(buf)) { + m = sizeof(buf); } n = Tcl_Read(in, buf, m); if (n == -1) { @@ -3628,7 +3630,7 @@ ZipFSCanonicalObjCmd( filename = TclGetString(objv[2]); result = CanonicalPath(mntpoint, filename, &dPath, zipfs); } - Tcl_SetObjResult(interp, Tcl_NewStringObj(result, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1)); return TCL_OK; } @@ -3673,7 +3675,7 @@ ZipFSExistsObjCmd( filename = TclGetString(objv[1]); Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1); - Tcl_DStringAppend(&ds, filename, TCL_INDEX_NONE); + Tcl_DStringAppend(&ds, filename, -1); filename = Tcl_DStringValue(&ds); ReadLock(); @@ -3724,7 +3726,7 @@ ZipFSInfoObjCmd( Tcl_Obj *result = Tcl_GetObjResult(interp); Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->zipFilePtr->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(z->zipFilePtr->name, -1)); Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->numBytes)); Tcl_ListObjAppendElement(interp, result, @@ -3810,7 +3812,7 @@ ZipFSListObjCmd( if (Tcl_StringMatch(z->name, pattern)) { Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(z->name, -1)); } } } else if (regexp) { @@ -3820,7 +3822,7 @@ ZipFSListObjCmd( if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) { Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(z->name, -1)); } } } else { @@ -3829,7 +3831,7 @@ ZipFSListObjCmd( ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr); Tcl_ListObjAppendElement(interp, result, - Tcl_NewStringObj(z->name, TCL_INDEX_NONE)); + Tcl_NewStringObj(z->name, -1)); } } Unlock(); @@ -3873,7 +3875,7 @@ TclZipfs_TclLibrary(void) */ if (zipfs_literal_tcl_library) { - return Tcl_NewStringObj(zipfs_literal_tcl_library, TCL_INDEX_NONE); + return Tcl_NewStringObj(zipfs_literal_tcl_library, -1); } /* @@ -3887,7 +3889,7 @@ TclZipfs_TclLibrary(void) Tcl_DecrRefCount(vfsInitScript); if (found == TCL_OK) { zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library"; - return Tcl_NewStringObj(zipfs_literal_tcl_library, TCL_INDEX_NONE); + return Tcl_NewStringObj(zipfs_literal_tcl_library, -1); } /* @@ -3906,17 +3908,17 @@ TclZipfs_TclLibrary(void) #endif if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) { - return Tcl_NewStringObj(zipfs_literal_tcl_library, TCL_INDEX_NONE); + return Tcl_NewStringObj(zipfs_literal_tcl_library, -1); } #elif !defined(NO_DLFCN_H) Dl_info dlinfo; if (dladdr((const void *)TclZipfs_TclLibrary, &dlinfo) && (dlinfo.dli_fname != NULL) && (ZipfsAppHookFindTclInit(dlinfo.dli_fname) == TCL_OK)) { - return Tcl_NewStringObj(zipfs_literal_tcl_library, TCL_INDEX_NONE); + return Tcl_NewStringObj(zipfs_literal_tcl_library, -1); } #else if (ZipfsAppHookFindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) { - return Tcl_NewStringObj(zipfs_literal_tcl_library, TCL_INDEX_NONE); + return Tcl_NewStringObj(zipfs_literal_tcl_library, -1); } #endif /* _WIN32 */ #endif /* !defined(STATIC_BUILD) */ @@ -3927,7 +3929,7 @@ TclZipfs_TclLibrary(void) */ if (zipfs_literal_tcl_library) { - return Tcl_NewStringObj(zipfs_literal_tcl_library, TCL_INDEX_NONE); + return Tcl_NewStringObj(zipfs_literal_tcl_library, -1); } return NULL; } @@ -4395,7 +4397,7 @@ ZipChannelOpen( * Wrap the ZipChannel into a Tcl_Channel. */ - sprintf(cname, "zipfs_%" TCL_Z_MODIFIER "x_%d", z->offset, + snprintf(cname, sizeof(cname), "zipfs_%" TCL_Z_MODIFIER "x_%d", z->offset, ZipFS.idCount++); z->zipFilePtr->numOpen++; Unlock(); @@ -4936,7 +4938,7 @@ static Tcl_Obj * ZipFSFilesystemSeparatorProc( TCL_UNUSED(Tcl_Obj *) /*pathPtr*/) { - return Tcl_NewStringObj("/", TCL_INDEX_NONE); + return Tcl_NewStringObj("/", -1); } /* @@ -5001,8 +5003,8 @@ ZipFSMatchInDirectoryProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); - int scnt, l, dirOnly = -1, strip = 0, mounts = 0; - size_t prefixLen, len; + int scnt, l, dirOnly = -1, mounts = 0; + Tcl_Size prefixLen, len, strip = 0; char *pat, *prefix, *path; Tcl_DString dsPref, *prefixBuf = NULL; @@ -5063,7 +5065,7 @@ ZipFSMatchInDirectoryProc( if (z && ((dirOnly < 0) || (!dirOnly && !z->isDirectory) || (dirOnly && z->isDirectory))) { - AppendWithPrefix(result, prefixBuf, z->name, TCL_INDEX_NONE); + AppendWithPrefix(result, prefixBuf, z->name, -1); } goto end; } @@ -5096,7 +5098,7 @@ ZipFSMatchInDirectoryProc( continue; } if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) { - AppendWithPrefix(result, prefixBuf, z->name + strip, TCL_INDEX_NONE); + AppendWithPrefix(result, prefixBuf, z->name + strip, -1); } } Tcl_Free(pat); @@ -5138,7 +5140,8 @@ ZipFSMatchMountPoints( { Tcl_HashEntry *hPtr; Tcl_HashSearch search; - size_t l, normLength; + size_t l; + Tcl_Size normLength; const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength); size_t len = normLength; @@ -5220,7 +5223,7 @@ ZipFSPathInFilesystemProc( Tcl_HashEntry *hPtr; Tcl_HashSearch search; int ret = -1; - size_t len; + Tcl_Size len; char *path; pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr); @@ -5247,9 +5250,9 @@ ZipFSPathInFilesystemProc( ZipEntry *z; for (z = zf->topEnts; z != NULL; z = z->tnext) { - size_t lenz = strlen(z->name); + Tcl_Size lenz = strlen(z->name); - if (((size_t) len >= lenz) && + if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) { ret = TCL_OK; goto endloop; @@ -5286,7 +5289,7 @@ ZipFSPathInFilesystemProc( static Tcl_Obj * ZipFSListVolumesProc(void) { - return Tcl_NewStringObj(ZIPFS_VOLUME, TCL_INDEX_NONE); + return Tcl_NewStringObj(ZIPFS_VOLUME, -1); } /* @@ -5367,7 +5370,7 @@ ZipFSFileAttrsGetProc( Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef) { - size_t len; + Tcl_Size len; int ret = TCL_OK; char *path; ZipEntry *z; @@ -5400,10 +5403,10 @@ ZipFSFileAttrsGetProc( z->zipFilePtr->mountPointLen); break; case ZIP_ATTR_ARCHIVE: - *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, TCL_INDEX_NONE); + *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1); break; case ZIP_ATTR_PERMISSIONS: - *objPtrRef = Tcl_NewStringObj("0o555", TCL_INDEX_NONE); + *objPtrRef = Tcl_NewStringObj("0o555", -1); break; case ZIP_ATTR_CRC: TclNewIntObj(*objPtrRef, z->crc32); @@ -5464,7 +5467,7 @@ static Tcl_Obj * ZipFSFilesystemPathTypeProc( TCL_UNUSED(Tcl_Obj *) /*pathPtr*/) { - return Tcl_NewStringObj("zip", TCL_INDEX_NONE); + return Tcl_NewStringObj("zip", -1); } /* @@ -5676,8 +5679,8 @@ TclZipfs_Init( */ Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj); - Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", TCL_INDEX_NONE), - Tcl_NewStringObj("::tcl::zipfs::find", TCL_INDEX_NONE)); + Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1), + Tcl_NewStringObj("::tcl::zipfs::find", -1)); Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init", ZipFSTclLibraryObjCmd, NULL, NULL); Tcl_PkgProvide(interp, "tcl::zipfs", "2.0"); diff --git a/generic/tclZlib.c b/generic/tclZlib.c index e016fd0fd4cb..e083243721d9 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -64,7 +64,7 @@ typedef struct { Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ Tcl_Obj *currentInput; /* Pointer to what is currently being * inflated. */ - size_t outPos; + Tcl_Size outPos; int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ @@ -289,7 +289,7 @@ ConvertError( case Z_NEED_DICT: codeStr = "NEED_DICT"; codeStr2 = codeStrBuf; - sprintf(codeStrBuf, "%lu", adler); + snprintf(codeStrBuf, sizeof(codeStrBuf), "%lu", adler); break; /* @@ -310,10 +310,10 @@ ConvertError( default: codeStr = "UNKNOWN"; codeStr2 = codeStrBuf; - sprintf(codeStrBuf, "%d", code); + snprintf(codeStrBuf, sizeof(codeStrBuf), "%d", code); break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1)); /* * Tricky point! We might pass NULL twice here (and will when the error @@ -350,7 +350,7 @@ ConvertErrorToList( return Tcl_NewListObj(3, objv); case Z_ERRNO: TclNewLiteralStringObj(objv[2], "POSIX"); - objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), TCL_INDEX_NONE); + objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); return Tcl_NewListObj(4, objv); case Z_NEED_DICT: TclNewLiteralStringObj(objv[2], "NEED_DICT"); @@ -405,7 +405,7 @@ GetValue( const char *nameStr, Tcl_Obj **valuePtrPtr) { - Tcl_Obj *name = Tcl_NewStringObj(nameStr, TCL_INDEX_NONE); + Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1); int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr); TclDecrRefCount(name); @@ -423,7 +423,7 @@ GenerateHeader( { Tcl_Obj *value; int len, result = TCL_ERROR; - size_t length; + Tcl_Size length; Tcl_WideInt wideValue = 0; const char *valueStr; Tcl_Encoding latin1enc; @@ -555,7 +555,7 @@ GenerateHeader( */ #define SetValue(dictObj, key, value) \ - Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), TCL_INDEX_NONE), (value)) + Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value)) static void ExtractHeader( @@ -606,7 +606,7 @@ ExtractHeader( } if (headerPtr->text != Z_UNKNOWN) { SetValue(dictObj, "type", - Tcl_NewStringObj(headerPtr->text ? "text" : "binary", TCL_INDEX_NONE)); + Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1)); } if (latin1enc != NULL) { @@ -624,7 +624,7 @@ SetInflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - size_t length = 0; + Tcl_Size length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); if (bytes == NULL) { @@ -641,7 +641,7 @@ SetDeflateDictionary( Tcl_Obj *compDictObj) { if (compDictObj != NULL) { - size_t length = 0; + Tcl_Size length = 0; unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); if (bytes == NULL) { @@ -849,7 +849,7 @@ Tcl_ZlibStreamInit( if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname), NULL, 0) != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "BUG: Stream command name already exists", TCL_INDEX_NONE)); + "BUG: Stream command name already exists", -1)); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL); Tcl_DStringFree(&cmdname); goto error; @@ -1191,7 +1191,7 @@ Tcl_ZlibStreamSetCompressionDictionary( ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; if (compressionDictionaryObj && (NULL == Tcl_GetByteArrayFromObj( - compressionDictionaryObj, (size_t *)NULL))) { + compressionDictionaryObj, (Tcl_Size *)NULL))) { /* Missing or invalid compression dictionary */ compressionDictionaryObj = NULL; } @@ -1234,13 +1234,14 @@ Tcl_ZlibStreamPut( ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; char *dataTmp = NULL; int e; - size_t size = 0, outSize, toStore; + Tcl_Size size = 0; + size_t outSize, toStore; unsigned char *bytes; if (zshPtr->streamEnd) { if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "already past compressed stream end", TCL_INDEX_NONE)); + "already past compressed stream end", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); } return TCL_ERROR; @@ -1359,15 +1360,15 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - size_t count) /* Number of bytes to grab as a maximum, you + Tcl_Size count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; int e; - size_t listLen, i, itemLen = 0, dataPos = 0; + Tcl_Size listLen, i, itemLen = 0, dataPos = 0; Tcl_Obj *itemObj; unsigned char *dataPtr, *itemPtr; - size_t existing = 0; + Tcl_Size existing = 0; /* * Getting beyond the of stream, just return empty string. @@ -1382,7 +1383,7 @@ Tcl_ZlibStreamGet( } if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) { - if (count == TCL_INDEX_NONE) { + if (count < 0) { /* * The only safe thing to do is restict to 65k. We might cause a * panic for out of memory if we just kept growing the buffer. @@ -1471,7 +1472,7 @@ Tcl_ZlibStreamGet( if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "unexpected zlib internal state during" - " decompression", TCL_INDEX_NONE)); + " decompression", -1)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", NULL); } @@ -1539,7 +1540,7 @@ Tcl_ZlibStreamGet( } } else { TclListObjLengthM(NULL, zshPtr->outData, &listLen); - if (count == TCL_INDEX_NONE) { + if (count < 0) { count = 0; for (i=0; ioutData, i, &itemObj); @@ -1569,8 +1570,8 @@ Tcl_ZlibStreamGet( Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - if (itemLen-zshPtr->outPos + dataPos >= count) { - size_t len = count - dataPos; + if ((itemLen-zshPtr->outPos) >= count-dataPos) { + Tcl_Size len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); zshPtr->outPos += len; @@ -1579,7 +1580,7 @@ Tcl_ZlibStreamGet( zshPtr->outPos = 0; } } else { - size_t len = itemLen - zshPtr->outPos; + Tcl_Size len = itemLen - zshPtr->outPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); dataPos += len; @@ -1616,7 +1617,7 @@ Tcl_ZlibDeflate( Tcl_Obj *gzipHeaderDictObj) { int wbits = 0, e = 0, extraSize = 0; - size_t inLen = 0; + Tcl_Size inLen = 0; Byte *inData = NULL; z_stream stream; GzipHeader header; @@ -1738,7 +1739,7 @@ Tcl_ZlibDeflate( } /* - * Reduce the bytearray length to the actual data length produced by + * Reduce the ByteArray length to the actual data length produced by * deflate. */ @@ -1767,11 +1768,11 @@ Tcl_ZlibInflate( Tcl_Interp *interp, int format, Tcl_Obj *data, - size_t bufferSize, + Tcl_Size bufferSize, Tcl_Obj *gzipHeaderDictObj) { int wbits = 0, e = 0; - size_t inLen = 0, newBufferSize; + Tcl_Size inLen = 0, newBufferSize; Byte *inData = NULL, *outData = NULL, *newOutData = NULL; z_stream stream; gz_header header, *headerPtr = NULL; @@ -1956,7 +1957,7 @@ unsigned int Tcl_ZlibCRC32( unsigned int crc, const unsigned char *buf, - size_t len) + Tcl_Size len) { /* Nothing much to do, just wrap the crc32(). */ return crc32(crc, (Bytef *) buf, len); @@ -1966,7 +1967,7 @@ unsigned int Tcl_ZlibAdler32( unsigned int adler, const unsigned char *buf, - size_t len) + Tcl_Size len) { return adler32(adler, (Bytef *) buf, len); } @@ -1989,7 +1990,9 @@ ZlibCmd( Tcl_Obj *const objv[]) { int i, option, level = -1; - size_t dlen = 0, start, buffersize = 0; + size_t buffersize = 0; + Tcl_Size dlen = 0; + unsigned int start; Tcl_WideInt wideLen; Byte *data; Tcl_Obj *headerDictObj; @@ -2236,7 +2239,7 @@ ZlibCmd( return TCL_ERROR; badLevel: - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); if (extraInfoStr) { Tcl_AddErrorInfo(interp, extraInfoStr); @@ -2387,7 +2390,7 @@ ZlibStreamSubcmd( } if (compDictObj) { - if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL)) { return TCL_ERROR; } } @@ -2446,7 +2449,7 @@ ZlibPushSubcmd( enum pushOptionsEnum {poDictionary, poHeader, poLevel, poLimit} option; Tcl_Obj *headerObj = NULL, *compDictObj = NULL; int limit = DEFAULT_BUFFER_SIZE; - size_t dummy; + Tcl_Size dummy; if (objc < 4) { Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?"); @@ -2499,7 +2502,7 @@ ZlibPushSubcmd( if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "compression may only be applied to writable channels", TCL_INDEX_NONE)); + "compression may only be applied to writable channels", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL); return TCL_ERROR; } @@ -2539,7 +2542,7 @@ ZlibPushSubcmd( } if (level < 0 || level > 9) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", TCL_INDEX_NONE)); + "level must be 0 to 9", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); goto genericOptionError; @@ -2561,7 +2564,7 @@ ZlibPushSubcmd( if (format == TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "a compression dictionary may not be set in the " - "gzip format", TCL_INDEX_NONE)); + "gzip format", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL); goto genericOptionError; } @@ -2570,7 +2573,7 @@ ZlibPushSubcmd( } } - if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL))) { + if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL))) { return TCL_ERROR; } @@ -2773,7 +2776,7 @@ ZlibStreamAddCmd( if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-buffer\" option must be followed by integer " - "decompression buffersize", TCL_INDEX_NONE)); + "decompression buffersize", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } @@ -2792,7 +2795,7 @@ ZlibStreamAddCmd( if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" - " compression dictionary bytes", TCL_INDEX_NONE)); + " compression dictionary bytes", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } @@ -2803,7 +2806,7 @@ ZlibStreamAddCmd( if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", TCL_INDEX_NONE)); + " are mutually exclusive", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL); return TCL_ERROR; } @@ -2817,7 +2820,7 @@ ZlibStreamAddCmd( */ if (compDictObj != NULL) { - size_t len = 0; + Tcl_Size len = 0; if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; @@ -2900,7 +2903,7 @@ ZlibStreamPutCmd( if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" - " compression dictionary bytes", TCL_INDEX_NONE)); + " compression dictionary bytes", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); return TCL_ERROR; } @@ -2910,7 +2913,7 @@ ZlibStreamPutCmd( if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", TCL_INDEX_NONE)); + " are mutually exclusive", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL); return TCL_ERROR; } @@ -2924,7 +2927,7 @@ ZlibStreamPutCmd( */ if (compDictObj != NULL) { - size_t len = 0; + Tcl_Size len = 0; if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, &len)) { return TCL_ERROR; @@ -2958,7 +2961,7 @@ ZlibStreamHeaderCmd( } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "only gunzip streams can produce header information", TCL_INDEX_NONE)); + "only gunzip streams can produce header information", -1)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL); return TCL_ERROR; } @@ -3272,7 +3275,7 @@ ZlibTransformOutput( Tcl_ListObjAppendElement(NULL, errObj, ConvertErrorToList(e, cd->outStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->outStream.msg, TCL_INDEX_NONE)); + Tcl_NewStringObj(cd->outStream.msg, -1)); Tcl_SetChannelError(cd->parent, errObj); *errorCodePtr = EINVAL; return -1; @@ -3367,7 +3370,7 @@ ZlibTransformSetOption( /* not used */ TclNewStringObj(compDictObj, value, strlen(value)); Tcl_IncrRefCount(compDictObj); - if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (size_t *)NULL)) { + if (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL)) { Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } @@ -3422,7 +3425,7 @@ ZlibTransformSetOption( /* not used */ return TCL_ERROR; } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-limit must be between 1 and 65536", TCL_INDEX_NONE)); + "-limit must be between 1 and 65536", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL); return TCL_ERROR; } @@ -3491,12 +3494,12 @@ ZlibTransformGetOption( crc = cd->inStream.adler; } - sprintf(buf, "%lu", crc); + snprintf(buf, sizeof(buf), "%lu", crc); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-checksum"); Tcl_DStringAppendElement(dsPtr, buf); } else { - Tcl_DStringAppend(dsPtr, buf, TCL_INDEX_NONE); + Tcl_DStringAppend(dsPtr, buf, -1); return TCL_OK; } } @@ -3517,7 +3520,7 @@ ZlibTransformGetOption( } } else { if (cd->compDictObj) { - size_t length; + Tcl_Size length; const char *str = Tcl_GetStringFromObj(cd->compDictObj, &length); Tcl_DStringAppend(dsPtr, str, length); @@ -3758,7 +3761,7 @@ ZlibStackChannelTransform( if (compDictObj != NULL) { cd->compDictObj = Tcl_DuplicateObj(compDictObj); Tcl_IncrRefCount(cd->compDictObj); - Tcl_GetByteArrayFromObj(cd->compDictObj, (size_t *)NULL); + Tcl_GetByteArrayFromObj(cd->compDictObj, (Tcl_Size *)NULL); } if (format == TCL_ZLIB_FORMAT_RAW) { @@ -3822,7 +3825,7 @@ ZlibStackChannelTransform( } cd->chan = chan; cd->parent = Tcl_GetStackedChannel(chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); return chan; error: @@ -3952,7 +3955,7 @@ ResultDecompress( Tcl_ListObjAppendElement(NULL, errObj, ConvertErrorToList(e, cd->inStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->inStream.msg, TCL_INDEX_NONE)); + Tcl_NewStringObj(cd->inStream.msg, -1)); Tcl_SetChannelError(cd->parent, errObj); *errorCodePtr = EINVAL; return -1; @@ -4027,7 +4030,7 @@ Tcl_ZlibStreamInit( Tcl_ZlibStream *zshandle) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); } return TCL_ERROR; @@ -4095,7 +4098,7 @@ Tcl_ZlibDeflate( Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); } return TCL_ERROR; @@ -4110,7 +4113,7 @@ Tcl_ZlibInflate( Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); } return TCL_ERROR; diff --git a/library/auto.tcl b/library/auto.tcl index 1b1c7fe571aa..0bfd4f4448b3 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -180,7 +180,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { $basename$patch library] } } - # uniquify $dirs in order + # make $dirs unique, preserving order array set seen {} foreach i $dirs { # Make sure $i is unique under normalization. Avoid repeated [source]. @@ -380,7 +380,7 @@ namespace eval auto_mkindex_parser { $parser expose eval $parser invokehidden rename eval _%@eval - # Install all the registered psuedo-command implementations + # Install all the registered pseudo-command implementations foreach cmd $initCommands { eval $cmd @@ -633,7 +633,7 @@ auto_mkindex_parser::hook { load {} tbcload $auto_mkindex_parser::parser # AUTO MKINDEX: tbcload::bcproc name arglist body - # Adds an entry to the auto index list for the given pre-compiled + # Adds an entry to the auto index list for the given precompiled # procedure name. auto_mkindex_parser::commandInit tbcload::bcproc {name args} { @@ -688,7 +688,7 @@ auto_mkindex_parser::command namespace {op args} { } regsub -all ::+ $name :: name } - # create artifical proc to force an entry in the tclIndex + # create artificial proc to force an entry in the tclIndex $parser eval [list ::proc $name {} {}] } } diff --git a/library/clock.tcl b/library/clock.tcl index 136ded2e4114..be4abf8c514d 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -223,7 +223,7 @@ proc ::tcl::clock::Initialize {} { ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639 - # Romania (Transylvania changed earler - perhaps de_RO should show the + # Romania (Transylvania changed earlier - perhaps de_RO should show the # earlier date?) ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063 @@ -2298,7 +2298,7 @@ proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } { # Returns the locale that was previously current. # # Side effects: -# Does [mclocale]. If necessary, loades the designated locale's files. +# Does [mclocale]. If necessary, loads the designated locale's files. # #---------------------------------------------------------------------- @@ -2605,7 +2605,7 @@ proc ::tcl::clock::FormatStarDate { date } { # # Parameters: # year - Year from the Roddenberry epoch -# fractYear - Fraction of a year specifiying the day of year. +# fractYear - Fraction of a year specifying the day of year. # fractDay - Fraction of a day # # Results: @@ -2975,7 +2975,7 @@ proc ::tcl::clock::InterpretHMS { date } { # Returns the system time zone. # # Side effects: -# Stores the sustem time zone in the 'CachedSystemTimeZone' +# Stores the system time zone in the 'CachedSystemTimeZone' # variable, since determining it may be an expensive process. # #---------------------------------------------------------------------- @@ -3401,7 +3401,7 @@ proc ::tcl::clock::ReadZoneinfoFile {fileName fname} { close $f # The file begins with a magic number, sixteen reserved bytes, and then - # six 4-byte integers giving counts of fileds in the file. + # six 4-byte integers giving counts of fields in the file. binary scan $d a4a1x15IIIIII \ magic version nIsGMT nIsStd nLeap nTime nType nChar diff --git a/library/history.tcl b/library/history.tcl index 486702187a78..5dd6b06b5549 100644 --- a/library/history.tcl +++ b/library/history.tcl @@ -268,7 +268,7 @@ proc ::tcl::HistIndex {event} { return -code error "event \"$event\" is too far in the past" } if {$i > $history(nextid)} { - return -code error "event \"$event\" hasn't occured yet" + return -code error "event \"$event\" hasn't occurred yet" } return $i } diff --git a/library/http/http.tcl b/library/http/http.tcl index 79f876a64379..6c3c068c7b72 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -3322,7 +3322,7 @@ proc http::postError {token} { # token The token returned from http::geturl # # Side Effects -# unsets the state array +# Unsets the state array. proc http::cleanup {token} { variable $token @@ -3350,7 +3350,7 @@ proc http::cleanup {token} { # http::Connect # -# This callback is made when an asyncronous connection completes. +# This callback is made when an asynchronous connection completes. # # Arguments # token The token returned from http::geturl @@ -3392,7 +3392,7 @@ proc http::Connect {token proto phost srvurl} { # If any other requests are in flight or pipelined/queued, they will # be discarded. } - Finish $token "connect failed $err" + Finish $token "connect failed: $err" return } @@ -4457,7 +4457,7 @@ proc http::CopyChunk {token chunk} { # # Arguments # token The token returned from http::geturl -# count The amount transfered +# count The amount transferred # # Side Effects # Invokes callbacks diff --git a/library/init.tcl b/library/init.tcl index 2646aa7ab08f..52ae079f019a 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -140,7 +140,7 @@ if {[namespace which -command exec] eq ""} { set auto_noexec 1 } -# Define a log command (which can be overwitten to log errors +# Define a log command (which can be overwritten to log errors # differently, specially when stderr is not available) if {[namespace which -command tclLog] eq ""} { @@ -734,7 +734,7 @@ proc tcl::CopyDirectory {action src dest} { # the following code is now commented out. # # return -code error "error $action \"$src\" to\ - # \"$dest\": file already exists" + # \"$dest\": file exists" } else { # Depending on the platform, and on the current # working directory, the directories '.', '..' @@ -746,7 +746,7 @@ proc tcl::CopyDirectory {action src dest} { foreach s $existing { if {[file tail $s] ni {. ..}} { return -code error "error $action \"$src\" to\ - \"$dest\": file already exists" + \"$dest\": file exists" } } } diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl index 12ab43f058a3..fa21685bf5e9 100644 --- a/library/msgcat/msgcat.tcl +++ b/library/msgcat/msgcat.tcl @@ -34,7 +34,7 @@ namespace eval msgcat { # Configuration values per Package (e.g. client namespace). # The dict key is of the form "